/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl
-/
import analysis.normed.group.infinite_sum
import topology.algebra.module.basic
import topology.instances.ennreal
import topology.instances.rat

/-!
# Normed fields

In this file we define (semi)normed rings and fields. We also prove some theorems about these
definitions.
-/

variables {α : Type*} {β : Type*} {γ : Type*} {ι : Type*}

noncomputable theory
open filter metric
open_locale topological_space big_operators nnreal ennreal uniformity pointwise

/-- A non-unital seminormed ring is a not-necessarily-unital ring
endowed with a seminorm which satisfies the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/
class non_unital_semi_normed_ring (α : Type*)
  extends has_norm α, non_unital_ring α, pseudo_metric_space α :=
(dist_eq : ∀ x y, dist x y = norm (x - y))
(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b)

/-- A seminormed ring is a ring endowed with a seminorm which satisfies the inequality
`∥x y∥ ≤ ∥x∥ ∥y∥`. -/
class semi_normed_ring (α : Type*) extends has_norm α, ring α, pseudo_metric_space α :=
(dist_eq : ∀ x y, dist x y = norm (x - y))
(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b)

/-- A seminormed ring is a non-unital seminormed ring. -/
@[priority 100] -- see Note [lower instance priority]
instance semi_normed_ring.to_non_unital_semi_normed_ring [β : semi_normed_ring α] :
  non_unital_semi_normed_ring α :=
{ ..β }

/-- A non-unital normed ring is a not-necessarily-unital ring
endowed with a norm which satisfies the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/
class non_unital_normed_ring (α : Type*) extends has_norm α, non_unital_ring α, metric_space α :=
(dist_eq : ∀ x y, dist x y = norm (x - y))
(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b)

/-- A non-unital normed ring is a non-unital seminormed ring. -/
@[priority 100] -- see Note [lower instance priority]
instance non_unital_normed_ring.to_non_unital_semi_normed_ring [β : non_unital_normed_ring α] :
  non_unital_semi_normed_ring α :=
{ ..β }

/-- A normed ring is a ring endowed with a norm which satisfies the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/
class normed_ring (α : Type*) extends has_norm α, ring α, metric_space α :=
(dist_eq : ∀ x y, dist x y = norm (x - y))
(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b)

/-- A normed division ring is a division ring endowed with a seminorm which satisfies the equality
`∥x y∥ = ∥x∥ ∥y∥`. -/
class normed_division_ring (α : Type*) extends has_norm α, division_ring α, metric_space α :=
(dist_eq : ∀ x y, dist x y = norm (x - y))
(norm_mul' : ∀ a b, norm (a * b) = norm a * norm b)

/-- A normed division ring is a normed ring. -/
@[priority 100] -- see Note [lower instance priority]
instance normed_division_ring.to_normed_ring [β : normed_division_ring α] : normed_ring α :=
{ norm_mul := λ a b, (normed_division_ring.norm_mul' a b).le,
  ..β }

/-- A normed ring is a seminormed ring. -/
@[priority 100] -- see Note [lower instance priority]
instance normed_ring.to_semi_normed_ring [β : normed_ring α] : semi_normed_ring α :=
{ ..β }

/-- A normed ring is a non-unital normed ring. -/
@[priority 100] -- see Note [lower instance priority]
instance normed_ring.to_non_unital_normed_ring [β : normed_ring α] : non_unital_normed_ring α :=
{ ..β }

/-- A seminormed commutative ring is a commutative ring endowed with a seminorm which satisfies
the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/
class semi_normed_comm_ring (α : Type*) extends semi_normed_ring α :=
(mul_comm : ∀ x y : α, x * y = y * x)

/-- A normed commutative ring is a commutative ring endowed with a norm which satisfies
the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/
class normed_comm_ring (α : Type*) extends normed_ring α :=
(mul_comm : ∀ x y : α, x * y = y * x)

/-- A normed commutative ring is a seminormed commutative ring. -/
@[priority 100] -- see Note [lower instance priority]
instance normed_comm_ring.to_semi_normed_comm_ring [β : normed_comm_ring α] :
  semi_normed_comm_ring α := { ..β }

instance : normed_comm_ring punit :=
{ norm_mul := λ _ _, by simp,
  ..punit.normed_group,
  ..punit.comm_ring, }

/-- A mixin class with the axiom `∥1∥ = 1`. Many `normed_ring`s and all `normed_field`s satisfy this
axiom. -/
class norm_one_class (α : Type*) [has_norm α] [has_one α] : Prop :=
(norm_one : ∥(1:α)∥ = 1)

export norm_one_class (norm_one)

attribute [simp] norm_one

@[simp] lemma nnnorm_one [semi_normed_group α] [has_one α] [norm_one_class α] : ∥(1 : α)∥₊ = 1 :=
nnreal.eq norm_one

@[priority 100] -- see Note [lower instance priority]
instance semi_normed_comm_ring.to_comm_ring [β : semi_normed_comm_ring α] : comm_ring α := { ..β }

@[priority 100] -- see Note [lower instance priority]
instance non_unital_normed_ring.to_normed_group [β : non_unital_normed_ring α] : normed_group α :=
{ ..β }

@[priority 100] -- see Note [lower instance priority]
instance non_unital_semi_normed_ring.to_semi_normed_group [β : non_unital_semi_normed_ring α] :
  semi_normed_group α := { ..β }

instance prod.norm_one_class [semi_normed_group α] [has_one α] [norm_one_class α]
  [semi_normed_group β] [has_one β] [norm_one_class β] :
  norm_one_class (α × β) :=
⟨by simp [prod.norm_def]⟩

section non_unital_semi_normed_ring
variables [non_unital_semi_normed_ring α]

lemma norm_mul_le (a b : α) : (∥a*b∥) ≤ (∥a∥) * (∥b∥) :=
non_unital_semi_normed_ring.norm_mul _ _

lemma nnnorm_mul_le (a b : α) : ∥a * b∥₊ ≤ ∥a∥₊ * ∥b∥₊ :=
by simpa only [←norm_to_nnreal, ←real.to_nnreal_mul (norm_nonneg _)]
  using real.to_nnreal_mono (norm_mul_le _ _)

/-- In a seminormed ring, the left-multiplication `add_monoid_hom` is bounded. -/
lemma mul_left_bound (x : α) :
  ∀ (y:α), ∥add_monoid_hom.mul_left x y∥ ≤ ∥x∥ * ∥y∥ :=
norm_mul_le x

/-- In a seminormed ring, the right-multiplication `add_monoid_hom` is bounded. -/
lemma mul_right_bound (x : α) :
  ∀ (y:α), ∥add_monoid_hom.mul_right x y∥ ≤ ∥x∥ * ∥y∥ :=
λ y, by {rw mul_comm, convert norm_mul_le y x}

/-- Non-unital seminormed ring structure on the product of two non-unital seminormed rings,
  using the sup norm. -/
instance prod.non_unital_semi_normed_ring [non_unital_semi_normed_ring β] :
  non_unital_semi_normed_ring (α × β) :=
{ norm_mul := assume x y,
  calc
    ∥x * y∥ = ∥(x.1*y.1, x.2*y.2)∥ : rfl
        ... = (max ∥x.1*y.1∥  ∥x.2*y.2∥) : rfl
        ... ≤ (max (∥x.1∥*∥y.1∥) (∥x.2∥*∥y.2∥)) :
          max_le_max (norm_mul_le (x.1) (y.1)) (norm_mul_le (x.2) (y.2))
        ... = (max (∥x.1∥*∥y.1∥) (∥y.2∥*∥x.2∥)) : by simp[mul_comm]
        ... ≤ (max (∥x.1∥) (∥x.2∥)) * (max (∥y.2∥) (∥y.1∥)) :
          by apply max_mul_mul_le_max_mul_max; simp [norm_nonneg]
        ... = (max (∥x.1∥) (∥x.2∥)) * (max (∥y.1∥) (∥y.2∥)) : by simp [max_comm]
        ... = (∥x∥*∥y∥) : rfl,
  ..prod.semi_normed_group }

end non_unital_semi_normed_ring

section semi_normed_ring

variables [semi_normed_ring α]

/-- A subalgebra of a seminormed ring is also a seminormed ring, with the restriction of the norm.

See note [implicit instance arguments]. -/
instance subalgebra.semi_normed_ring {𝕜 : Type*} {_ : comm_ring 𝕜}
  {E : Type*} [semi_normed_ring E] {_ : algebra 𝕜 E} (s : subalgebra 𝕜 E) : semi_normed_ring s :=
{ norm_mul := λ a b, norm_mul_le a.1 b.1,
  ..s.to_submodule.semi_normed_group }

/-- A subalgebra of a normed ring is also a normed ring, with the restriction of the norm.

See note [implicit instance arguments]. -/
instance subalgebra.normed_ring {𝕜 : Type*} {_ : comm_ring 𝕜}
  {E : Type*} [normed_ring E] {_ : algebra 𝕜 E} (s : subalgebra 𝕜 E) : normed_ring s :=
{ ..s.semi_normed_ring }

lemma list.norm_prod_le' : ∀ {l : list α}, l ≠ [] → ∥l.prod∥ ≤ (l.map norm).prod
| [] h := (h rfl).elim
| [a] _ := by simp
| (a :: b :: l) _ :=
  begin
    rw [list.map_cons, list.prod_cons, @list.prod_cons _ _ _ ∥a∥],
    refine le_trans (norm_mul_le _ _) (mul_le_mul_of_nonneg_left _ (norm_nonneg _)),
    exact list.norm_prod_le' (list.cons_ne_nil b l)
  end

lemma list.norm_prod_le [norm_one_class α] : ∀ l : list α, ∥l.prod∥ ≤ (l.map norm).prod
| [] := by simp
| (a::l) := list.norm_prod_le' (list.cons_ne_nil a l)

lemma finset.norm_prod_le' {α : Type*} [normed_comm_ring α] (s : finset ι) (hs : s.nonempty)
  (f : ι → α) :
  ∥∏ i in s, f i∥ ≤ ∏ i in s, ∥f i∥ :=
begin
  rcases s with ⟨⟨l⟩, hl⟩,
  have : l.map f ≠ [], by simpa using hs,
  simpa using list.norm_prod_le' this
end

lemma finset.norm_prod_le {α : Type*} [normed_comm_ring α] [norm_one_class α] (s : finset ι)
  (f : ι → α) :
  ∥∏ i in s, f i∥ ≤ ∏ i in s, ∥f i∥ :=
begin
  rcases s with ⟨⟨l⟩, hl⟩,
  simpa using (l.map f).norm_prod_le
end

/-- If `α` is a seminormed ring, then `∥a ^ n∥₊ ≤ ∥a∥₊ ^ n` for `n > 0`.
See also `nnnorm_pow_le`. -/
lemma nnnorm_pow_le' (a : α) : ∀ {n : ℕ}, 0 < n → ∥a ^ n∥₊ ≤ ∥a∥₊ ^ n
| 1 h := by simp only [pow_one]
| (n + 2) h := by simpa only [pow_succ _ (n + 1)] using
    le_trans (nnnorm_mul_le _ _) (mul_le_mul_left' (nnnorm_pow_le' n.succ_pos) _)

/-- If `α` is a seminormed ring with `∥1∥₊ = 1`, then `∥a ^ n∥₊ ≤ ∥a∥₊ ^ n`.
See also `nnnorm_pow_le'`.-/
lemma nnnorm_pow_le [norm_one_class α] (a : α) (n : ℕ) : ∥a ^ n∥₊ ≤ ∥a∥₊ ^ n :=
nat.rec_on n (by simp only [pow_zero, nnnorm_one]) (λ k hk, nnnorm_pow_le' a k.succ_pos)

/-- If `α` is a seminormed ring, then `∥a ^ n∥ ≤ ∥a∥ ^ n` for `n > 0`. See also `norm_pow_le`. -/
lemma norm_pow_le' (a : α) {n : ℕ} (h : 0 < n) : ∥a ^ n∥ ≤ ∥a∥ ^ n :=
by simpa only [nnreal.coe_pow, coe_nnnorm] using nnreal.coe_mono (nnnorm_pow_le' a h)

/-- If `α` is a seminormed ring with `∥1∥ = 1`, then `∥a ^ n∥ ≤ ∥a∥ ^ n`. See also `norm_pow_le'`.-/
lemma norm_pow_le [norm_one_class α] (a : α) (n : ℕ) : ∥a ^ n∥ ≤ ∥a∥ ^ n :=
nat.rec_on n (by simp only [pow_zero, norm_one]) (λ n hn, norm_pow_le' a n.succ_pos)

lemma eventually_norm_pow_le (a : α) : ∀ᶠ (n:ℕ) in at_top, ∥a ^ n∥ ≤ ∥a∥ ^ n :=
eventually_at_top.mpr ⟨1, λ b h, norm_pow_le' a (nat.succ_le_iff.mp h)⟩

/-- Seminormed ring structure on the product of two seminormed rings,
  using the sup norm. -/
instance prod.semi_normed_ring [semi_normed_ring β] :
  semi_normed_ring (α × β) :=
{ ..prod.non_unital_semi_normed_ring,
  ..prod.semi_normed_group, }

end semi_normed_ring

section non_unital_normed_ring
variables [non_unital_normed_ring α]

/-- Non-unital normed ring structure on the product of two non-unital normed rings,
using the sup norm. -/
instance prod.non_unital_normed_ring [non_unital_normed_ring β] : non_unital_normed_ring (α × β) :=
{ norm_mul := norm_mul_le,
  ..prod.semi_normed_group }

end non_unital_normed_ring

section normed_ring

variables [normed_ring α]

lemma units.norm_pos [nontrivial α] (x : αˣ) : 0 < ∥(x:α)∥ :=
norm_pos_iff.mpr (units.ne_zero x)

/-- Normed ring structure on the product of two normed rings, using the sup norm. -/
instance prod.normed_ring [normed_ring β] : normed_ring (α × β) :=
{ norm_mul := norm_mul_le,
  ..prod.semi_normed_group }

end normed_ring

@[priority 100] -- see Note [lower instance priority]
instance semi_normed_ring_top_monoid [non_unital_semi_normed_ring α] : has_continuous_mul α :=
⟨ continuous_iff_continuous_at.2 $ λ x, tendsto_iff_norm_tendsto_zero.2 $
    begin
      have : ∀ e : α × α, ∥e.1 * e.2 - x.1 * x.2∥ ≤ ∥e.1∥ * ∥e.2 - x.2∥ + ∥e.1 - x.1∥ * ∥x.2∥,
      { intro e,
        calc ∥e.1 * e.2 - x.1 * x.2∥ ≤ ∥e.1 * (e.2 - x.2) + (e.1 - x.1) * x.2∥ :
          by rw [mul_sub, sub_mul, sub_add_sub_cancel]
        ... ≤ ∥e.1∥ * ∥e.2 - x.2∥ + ∥e.1 - x.1∥ * ∥x.2∥ :
          norm_add_le_of_le (norm_mul_le _ _) (norm_mul_le _ _) },
      refine squeeze_zero (λ e, norm_nonneg _) this _,
      convert ((continuous_fst.tendsto x).norm.mul ((continuous_snd.tendsto x).sub
        tendsto_const_nhds).norm).add
        (((continuous_fst.tendsto x).sub tendsto_const_nhds).norm.mul _),
      show tendsto _ _ _, from tendsto_const_nhds,
      simp
    end ⟩

/-- A seminormed ring is a topological ring. -/
@[priority 100] -- see Note [lower instance priority]
instance semi_normed_top_ring [non_unital_semi_normed_ring α] : topological_ring α := { }

section normed_division_ring

variables [normed_division_ring α]

@[simp] lemma norm_mul (a b : α) : ∥a * b∥ = ∥a∥ * ∥b∥ :=
normed_division_ring.norm_mul' a b

@[priority 900]
instance normed_division_ring.to_norm_one_class : norm_one_class α :=
⟨mul_left_cancel₀ (mt norm_eq_zero.1 (@one_ne_zero α _ _)) $
  by rw [← norm_mul, mul_one, mul_one]⟩

export norm_one_class (norm_one)

@[simp] lemma nnnorm_mul (a b : α) : ∥a * b∥₊ = ∥a∥₊ * ∥b∥₊ :=
nnreal.eq $ norm_mul a b

/-- `norm` as a `monoid_with_zero_hom`. -/
@[simps] def norm_hom : α →*₀ ℝ := ⟨norm, norm_zero, norm_one, norm_mul⟩

/-- `nnnorm` as a `monoid_with_zero_hom`. -/
@[simps] def nnnorm_hom : α →*₀ ℝ≥0 := ⟨nnnorm, nnnorm_zero, nnnorm_one, nnnorm_mul⟩

@[simp] lemma norm_pow (a : α) : ∀ (n : ℕ), ∥a ^ n∥ = ∥a∥ ^ n :=
(norm_hom.to_monoid_hom : α →* ℝ).map_pow a

@[simp] lemma nnnorm_pow (a : α) (n : ℕ) : ∥a ^ n∥₊ = ∥a∥₊ ^ n :=
(nnnorm_hom.to_monoid_hom : α →* ℝ≥0).map_pow a n

protected lemma list.norm_prod (l : list α) : ∥l.prod∥ = (l.map norm).prod :=
(norm_hom.to_monoid_hom : α →* ℝ).map_list_prod _

protected lemma list.nnnorm_prod (l : list α) : ∥l.prod∥₊ = (l.map nnnorm).prod :=
(nnnorm_hom.to_monoid_hom : α →* ℝ≥0).map_list_prod _

@[simp] lemma norm_div (a b : α) : ∥a / b∥ = ∥a∥ / ∥b∥ := (norm_hom : α →*₀ ℝ).map_div a b

@[simp] lemma nnnorm_div (a b : α) : ∥a / b∥₊ = ∥a∥₊ / ∥b∥₊ := (nnnorm_hom : α →*₀ ℝ≥0).map_div a b

@[simp] lemma norm_inv (a : α) : ∥a⁻¹∥ = ∥a∥⁻¹ := (norm_hom : α →*₀ ℝ).map_inv a

@[simp] lemma nnnorm_inv (a : α) : ∥a⁻¹∥₊ = ∥a∥₊⁻¹ :=
nnreal.eq $ by simp

@[simp] lemma norm_zpow : ∀ (a : α) (n : ℤ), ∥a^n∥ = ∥a∥^n := (norm_hom : α →*₀ ℝ).map_zpow

@[simp] lemma nnnorm_zpow : ∀ (a : α) (n : ℤ), ∥a ^ n∥₊ = ∥a∥₊ ^ n :=
(nnnorm_hom : α →*₀ ℝ≥0).map_zpow

@[priority 100] -- see Note [lower instance priority]
instance normed_division_ring.to_has_continuous_inv₀ : has_continuous_inv₀ α :=
begin
  refine ⟨λ r r0, tendsto_iff_norm_tendsto_zero.2 _⟩,
  have r0' : 0 < ∥r∥ := norm_pos_iff.2 r0,
  rcases exists_between r0' with ⟨ε, ε0, εr⟩,
  have : ∀ᶠ e in 𝓝 r, ∥e⁻¹ - r⁻¹∥ ≤ ∥r - e∥ / ∥r∥ / ε,
  { filter_upwards [(is_open_lt continuous_const continuous_norm).eventually_mem εr] with e he,
    have e0 : e ≠ 0 := norm_pos_iff.1 (ε0.trans he),
    calc ∥e⁻¹ - r⁻¹∥ = ∥r∥⁻¹ * ∥r - e∥ * ∥e∥⁻¹ : by
      { rw [←norm_inv, ←norm_inv, ←norm_mul, ←norm_mul, mul_sub, sub_mul, mul_assoc _ e,
          inv_mul_cancel r0, mul_inv_cancel e0, one_mul, mul_one] }
    ...              = ∥r - e∥ / ∥r∥ / ∥e∥ : by field_simp [mul_comm]
    ... ≤ ∥r - e∥ / ∥r∥ / ε :
      div_le_div_of_le_left (div_nonneg (norm_nonneg _) (norm_nonneg _)) ε0 he.le },
  refine squeeze_zero' (eventually_of_forall $ λ _, norm_nonneg _) this _,
  refine (continuous_const.sub continuous_id).norm.div_const.div_const.tendsto' _ _ _,
  simp,
end

end normed_division_ring

/-- A normed field is a field with a norm satisfying ∥x y∥ = ∥x∥ ∥y∥. -/
class normed_field (α : Type*) extends has_norm α, field α, metric_space α :=
(dist_eq : ∀ x y, dist x y = norm (x - y))
(norm_mul' : ∀ a b, norm (a * b) = norm a * norm b)

/-- A nondiscrete normed field is a normed field in which there is an element of norm different from
`0` and `1`. This makes it possible to bring any element arbitrarily close to `0` by multiplication
by the powers of any element, and thus to relate algebra and topology. -/
class nondiscrete_normed_field (α : Type*) extends normed_field α :=
(non_trivial : ∃ x : α, 1 < ∥x∥)

section normed_field

variables [normed_field α]

@[priority 100] -- see Note [lower instance priority]
instance normed_field.to_normed_division_ring : normed_division_ring α :=
{ ..‹normed_field α› }

@[priority 100] -- see Note [lower instance priority]
instance normed_field.to_normed_comm_ring : normed_comm_ring α :=
{ norm_mul := λ a b, (norm_mul a b).le, ..‹normed_field α› }

@[simp] lemma norm_prod (s : finset β) (f : β → α) :
  ∥∏ b in s, f b∥ = ∏ b in s, ∥f b∥ :=
(norm_hom.to_monoid_hom : α →* ℝ).map_prod f s

@[simp] lemma nnnorm_prod (s : finset β) (f : β → α) :
  ∥∏ b in s, f b∥₊ = ∏ b in s, ∥f b∥₊ :=
(nnnorm_hom.to_monoid_hom : α →* ℝ≥0).map_prod f s

end normed_field

namespace normed_field

variables (α) [nondiscrete_normed_field α]

lemma exists_one_lt_norm : ∃x : α, 1 < ∥x∥ := ‹nondiscrete_normed_field α›.non_trivial

lemma exists_norm_lt_one : ∃x : α, 0 < ∥x∥ ∧ ∥x∥ < 1 :=
begin
  rcases exists_one_lt_norm α with ⟨y, hy⟩,
  refine ⟨y⁻¹, _, _⟩,
  { simp only [inv_eq_zero, ne.def, norm_pos_iff],
    rintro rfl,
    rw norm_zero at hy,
    exact lt_asymm zero_lt_one hy },
  { simp [inv_lt_one hy] }
end

lemma exists_lt_norm (r : ℝ) : ∃ x : α, r < ∥x∥ :=
let ⟨w, hw⟩ := exists_one_lt_norm α in
let ⟨n, hn⟩ := pow_unbounded_of_one_lt r hw in
⟨w^n, by rwa norm_pow⟩

lemma exists_norm_lt {r : ℝ} (hr : 0 < r) : ∃ x : α, 0 < ∥x∥ ∧ ∥x∥ < r :=
let ⟨w, hw⟩ := exists_one_lt_norm α in
let ⟨n, hle, hlt⟩ := exists_mem_Ioc_zpow hr hw in
⟨w^n, by { rw norm_zpow; exact zpow_pos_of_pos (lt_trans zero_lt_one hw) _},
by rwa norm_zpow⟩

variable {α}

@[instance]
lemma punctured_nhds_ne_bot (x : α) : ne_bot (𝓝[≠] x) :=
begin
  rw [← mem_closure_iff_nhds_within_ne_bot, metric.mem_closure_iff],
  rintros ε ε0,
  rcases exists_norm_lt α ε0 with ⟨b, hb0, hbε⟩,
  refine ⟨x + b, mt (set.mem_singleton_iff.trans add_right_eq_self).1 $ norm_pos_iff.1 hb0, _⟩,
  rwa [dist_comm, dist_eq_norm, add_sub_cancel'],
end

@[instance]
lemma nhds_within_is_unit_ne_bot : ne_bot (𝓝[{x : α | is_unit x}] 0) :=
by simpa only [is_unit_iff_ne_zero] using punctured_nhds_ne_bot (0:α)

end normed_field

instance : normed_field ℝ :=
{ norm_mul' := abs_mul,
  .. real.normed_group }

instance : nondiscrete_normed_field ℝ :=
{ non_trivial := ⟨2, by { unfold norm, rw abs_of_nonneg; norm_num }⟩ }

namespace real

lemma norm_of_nonneg {x : ℝ} (hx : 0 ≤ x) : ∥x∥ = x :=
abs_of_nonneg hx

lemma norm_of_nonpos {x : ℝ} (hx : x ≤ 0) : ∥x∥ = -x :=
abs_of_nonpos hx

@[simp] lemma norm_coe_nat (n : ℕ) : ∥(n : ℝ)∥ = n := abs_of_nonneg n.cast_nonneg

@[simp] lemma nnnorm_coe_nat (n : ℕ) : ∥(n : ℝ)∥₊ = n := nnreal.eq $ by simp

@[simp] lemma norm_two : ∥(2 : ℝ)∥ = 2 := abs_of_pos (@zero_lt_two ℝ _ _)

@[simp] lemma nnnorm_two : ∥(2 : ℝ)∥₊ = 2 := nnreal.eq $ by simp

lemma nnnorm_of_nonneg {x : ℝ} (hx : 0 ≤ x) : ∥x∥₊ = ⟨x, hx⟩ :=
nnreal.eq $ norm_of_nonneg hx

lemma ennnorm_eq_of_real {x : ℝ} (hx : 0 ≤ x) : (∥x∥₊ : ℝ≥0∞) = ennreal.of_real x :=
by { rw [← of_real_norm_eq_coe_nnnorm, norm_of_nonneg hx] }

lemma of_real_le_ennnorm (x : ℝ) : ennreal.of_real x ≤ ∥x∥₊ :=
begin
  by_cases hx : 0 ≤ x,
  { rw real.ennnorm_eq_of_real hx, refl' },
  { rw [ennreal.of_real_eq_zero.2 (le_of_lt (not_le.1 hx))],
    exact bot_le }
end

/-- If `E` is a nontrivial topological module over `ℝ`, then `E` has no isolated points.
This is a particular case of `module.punctured_nhds_ne_bot`. -/
instance punctured_nhds_module_ne_bot
  {E : Type*} [add_comm_group E] [topological_space E] [has_continuous_add E] [nontrivial E]
  [module ℝ E] [has_continuous_smul ℝ E] (x : E) :
  ne_bot (𝓝[≠] x) :=
module.punctured_nhds_ne_bot ℝ E x

end real

namespace nnreal

open_locale nnreal

@[simp] lemma norm_eq (x : ℝ≥0) : ∥(x : ℝ)∥ = x :=
by rw [real.norm_eq_abs, x.abs_eq]

@[simp] lemma nnnorm_eq (x : ℝ≥0) : ∥(x : ℝ)∥₊ = x :=
nnreal.eq $ real.norm_of_nonneg x.2

end nnreal

@[simp] lemma norm_norm [semi_normed_group α] (x : α) : ∥∥x∥∥ = ∥x∥ :=
real.norm_of_nonneg (norm_nonneg _)

@[simp] lemma nnnorm_norm [semi_normed_group α] (a : α) : ∥∥a∥∥₊ = ∥a∥₊ :=
by simpa [real.nnnorm_of_nonneg (norm_nonneg a)]

/-- A restatement of `metric_space.tendsto_at_top` in terms of the norm. -/
lemma normed_group.tendsto_at_top [nonempty α] [semilattice_sup α] {β : Type*} [semi_normed_group β]
  {f : α → β} {b : β} :
  tendsto f at_top (𝓝 b) ↔ ∀ ε, 0 < ε → ∃ N, ∀ n, N ≤ n → ∥f n - b∥ < ε :=
(at_top_basis.tendsto_iff metric.nhds_basis_ball).trans (by simp [dist_eq_norm])

/--
A variant of `normed_group.tendsto_at_top` that
uses `∃ N, ∀ n > N, ...` rather than `∃ N, ∀ n ≥ N, ...`
-/
lemma normed_group.tendsto_at_top' [nonempty α] [semilattice_sup α] [no_max_order α]
  {β : Type*} [semi_normed_group β]
  {f : α → β} {b : β} :
  tendsto f at_top (𝓝 b) ↔ ∀ ε, 0 < ε → ∃ N, ∀ n, N < n → ∥f n - b∥ < ε :=
(at_top_basis_Ioi.tendsto_iff metric.nhds_basis_ball).trans (by simp [dist_eq_norm])

instance : normed_comm_ring ℤ :=
{ norm := λ n, ∥(n : ℝ)∥,
  norm_mul := λ m n, le_of_eq $ by simp only [norm, int.cast_mul, abs_mul],
  dist_eq := λ m n, by simp only [int.dist_eq, norm, int.cast_sub],
  mul_comm := mul_comm }

@[norm_cast] lemma int.norm_cast_real (m : ℤ) : ∥(m : ℝ)∥ = ∥m∥ := rfl

lemma int.norm_eq_abs (n : ℤ) : ∥n∥ = |n| := rfl

lemma nnreal.coe_nat_abs (n : ℤ) : (n.nat_abs : ℝ≥0) = ∥n∥₊ :=
nnreal.eq $ calc ((n.nat_abs : ℝ≥0) : ℝ)
               = (n.nat_abs : ℤ) : by simp only [int.cast_coe_nat, nnreal.coe_nat_cast]
           ... = |n|           : by simp only [← int.abs_eq_nat_abs, int.cast_abs]
           ... = ∥n∥              : rfl

lemma int.abs_le_floor_nnreal_iff (z : ℤ) (c : ℝ≥0) : |z| ≤ ⌊c⌋₊ ↔ ∥z∥₊ ≤ c :=
begin
  rw [int.abs_eq_nat_abs, int.coe_nat_le, nat.le_floor_iff (zero_le c)],
  congr',
  exact nnreal.coe_nat_abs z,
end

instance : norm_one_class ℤ :=
⟨by simp [← int.norm_cast_real]⟩

instance : normed_field ℚ :=
{ norm := λ r, ∥(r : ℝ)∥,
  norm_mul' := λ r₁ r₂, by simp only [norm, rat.cast_mul, abs_mul],
  dist_eq := λ r₁ r₂, by simp only [rat.dist_eq, norm, rat.cast_sub] }

instance : nondiscrete_normed_field ℚ :=
{ non_trivial := ⟨2, by { unfold norm, rw abs_of_nonneg; norm_num }⟩ }

@[norm_cast, simp] lemma rat.norm_cast_real (r : ℚ) : ∥(r : ℝ)∥ = ∥r∥ := rfl

@[norm_cast, simp] lemma int.norm_cast_rat (m : ℤ) : ∥(m : ℚ)∥ = ∥m∥ :=
by rw [← rat.norm_cast_real, ← int.norm_cast_real]; congr' 1; norm_cast

-- Now that we've installed the norm on `ℤ`,
-- we can state some lemmas about `nsmul` and `zsmul`.
section
variables [semi_normed_group α]

lemma norm_nsmul_le (n : ℕ) (a : α) : ∥n • a∥ ≤ n * ∥a∥ :=
begin
  induction n with n ih,
  { simp only [norm_zero, nat.cast_zero, zero_mul, zero_smul] },
  simp only [nat.succ_eq_add_one, add_smul, add_mul, one_mul, nat.cast_add,
    nat.cast_one, one_nsmul],
  exact norm_add_le_of_le ih le_rfl
end

lemma norm_zsmul_le (n : ℤ) (a : α) : ∥n • a∥ ≤ ∥n∥ * ∥a∥ :=
begin
  induction n with n n,
  { simp only [int.of_nat_eq_coe, coe_nat_zsmul],
    convert norm_nsmul_le n a,
    exact nat.abs_cast n },
  { simp only [int.neg_succ_of_nat_coe, neg_smul, norm_neg, coe_nat_zsmul],
    convert norm_nsmul_le n.succ a,
    exact nat.abs_cast n.succ, }
end

lemma nnnorm_nsmul_le (n : ℕ) (a : α) : ∥n • a∥₊ ≤ n * ∥a∥₊ :=
by simpa only [←nnreal.coe_le_coe, nnreal.coe_mul, nnreal.coe_nat_cast]
  using norm_nsmul_le n a

lemma nnnorm_zsmul_le (n : ℤ) (a : α) : ∥n • a∥₊ ≤ ∥n∥₊ * ∥a∥₊ :=
by simpa only [←nnreal.coe_le_coe, nnreal.coe_mul] using norm_zsmul_le n a

end

section cauchy_product

/-! ## Multiplying two infinite sums in a normed ring

In this section, we prove various results about `(∑' x : ι, f x) * (∑' y : ι', g y)` in a normed
ring. There are similar results proven in `topology/algebra/infinite_sum` (e.g `tsum_mul_tsum`),
but in a normed ring we get summability results which aren't true in general.

We first establish results about arbitrary index types, `β` and `γ`, and then we specialize to
`β = γ = ℕ` to prove the Cauchy product formula
(see `tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm`).

### Arbitrary index types
-/

variables {ι' : Type*} [normed_ring α]

open finset
open_locale classical

lemma summable.mul_of_nonneg {f : ι → ℝ} {g : ι' → ℝ}
  (hf : summable f) (hg : summable g) (hf' : 0 ≤ f) (hg' : 0 ≤ g) :
  summable (λ (x : ι × ι'), f x.1 * g x.2) :=
let ⟨s, hf⟩ := hf in
let ⟨t, hg⟩ := hg in
suffices this : ∀ u : finset (ι × ι'), ∑ x in u, f x.1 * g x.2 ≤ s*t,
  from summable_of_sum_le (λ x, mul_nonneg (hf' _) (hg' _)) this,
assume u,
calc  ∑ x in u, f x.1 * g x.2
    ≤ ∑ x in (u.image prod.fst).product (u.image prod.snd), f x.1 * g x.2 :
      sum_mono_set_of_nonneg (λ x, mul_nonneg (hf' _) (hg' _)) subset_product
... = ∑ x in u.image prod.fst, ∑ y in u.image prod.snd, f x * g y : sum_product
... = ∑ x in u.image prod.fst, f x * ∑ y in u.image prod.snd, g y :
      sum_congr rfl (λ x _, mul_sum.symm)
... ≤ ∑ x in u.image prod.fst, f x * t :
      sum_le_sum
        (λ x _, mul_le_mul_of_nonneg_left (sum_le_has_sum _ (λ _ _, hg' _) hg) (hf' _))
... = (∑ x in u.image prod.fst, f x) * t : sum_mul.symm
... ≤ s * t :
      mul_le_mul_of_nonneg_right (sum_le_has_sum _ (λ _ _, hf' _) hf) (hg.nonneg $ λ _, hg' _)

lemma summable.mul_norm {f : ι → α} {g : ι' → α}
  (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) :
  summable (λ (x : ι × ι'), ∥f x.1 * g x.2∥) :=
summable_of_nonneg_of_le (λ x, norm_nonneg (f x.1 * g x.2)) (λ x, norm_mul_le (f x.1) (g x.2))
  (hf.mul_of_nonneg hg (λ x, norm_nonneg $ f x) (λ x, norm_nonneg $ g x) : _)

lemma summable_mul_of_summable_norm [complete_space α] {f : ι → α} {g : ι' → α}
  (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) :
  summable (λ (x : ι × ι'), f x.1 * g x.2) :=
summable_of_summable_norm (hf.mul_norm hg)

/-- Product of two infinites sums indexed by arbitrary types.
    See also `tsum_mul_tsum` if `f` and `g` are *not* absolutely summable. -/
lemma tsum_mul_tsum_of_summable_norm [complete_space α] {f : ι → α} {g : ι' → α}
  (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) :
  (∑' x, f x) * (∑' y, g y) = (∑' z : ι × ι', f z.1 * g z.2) :=
tsum_mul_tsum (summable_of_summable_norm hf) (summable_of_summable_norm hg)
  (summable_mul_of_summable_norm hf hg)

/-! ### `ℕ`-indexed families (Cauchy product)

We prove two versions of the Cauchy product formula. The first one is
`tsum_mul_tsum_eq_tsum_sum_range_of_summable_norm`, where the `n`-th term is a sum over
`finset.range (n+1)` involving `nat` substraction.
In order to avoid `nat` substraction, we also provide
`tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm`,
where the `n`-th term is a sum over all pairs `(k, l)` such that `k+l=n`, which corresponds to the
`finset` `finset.nat.antidiagonal n`. -/

section nat

open finset.nat

lemma summable_norm_sum_mul_antidiagonal_of_summable_norm {f g : ℕ → α}
  (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) :
  summable (λ n, ∥∑ kl in antidiagonal n, f kl.1 * g kl.2∥) :=
begin
  have := summable_sum_mul_antidiagonal_of_summable_mul
    (summable.mul_of_nonneg hf hg (λ _, norm_nonneg _) (λ _, norm_nonneg _)),
  refine summable_of_nonneg_of_le (λ _, norm_nonneg _) _ this,
  intros n,
  calc  ∥∑ kl in antidiagonal n, f kl.1 * g kl.2∥
      ≤ ∑ kl in antidiagonal n, ∥f kl.1 * g kl.2∥ : norm_sum_le _ _
  ... ≤ ∑ kl in antidiagonal n, ∥f kl.1∥ * ∥g kl.2∥ : sum_le_sum (λ i _, norm_mul_le _ _)
end

/-- The Cauchy product formula for the product of two infinite sums indexed by `ℕ`,
    expressed by summing on `finset.nat.antidiagonal`.
    See also `tsum_mul_tsum_eq_tsum_sum_antidiagonal` if `f` and `g` are
    *not* absolutely summable. -/
lemma tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm [complete_space α] {f g : ℕ → α}
  (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) :
  (∑' n, f n) * (∑' n, g n) = ∑' n, ∑ kl in antidiagonal n, f kl.1 * g kl.2 :=
tsum_mul_tsum_eq_tsum_sum_antidiagonal (summable_of_summable_norm hf) (summable_of_summable_norm hg)
  (summable_mul_of_summable_norm hf hg)

lemma summable_norm_sum_mul_range_of_summable_norm {f g : ℕ → α}
  (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) :
  summable (λ n, ∥∑ k in range (n+1), f k * g (n - k)∥) :=
begin
  simp_rw ← sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l),
  exact summable_norm_sum_mul_antidiagonal_of_summable_norm hf hg
end

/-- The Cauchy product formula for the product of two infinite sums indexed by `ℕ`,
    expressed by summing on `finset.range`.
    See also `tsum_mul_tsum_eq_tsum_sum_range` if `f` and `g` are
    *not* absolutely summable. -/
lemma tsum_mul_tsum_eq_tsum_sum_range_of_summable_norm [complete_space α] {f g : ℕ → α}
  (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) :
  (∑' n, f n) * (∑' n, g n) = ∑' n, ∑ k in range (n+1), f k * g (n - k) :=
begin
  simp_rw ← sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l),
  exact tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm hf hg
end

end nat

end cauchy_product

section ring_hom_isometric

variables {R₁ : Type*} {R₂ : Type*} {R₃ : Type*}

/-- This class states that a ring homomorphism is isometric. This is a sufficient assumption
for a continuous semilinear map to be bounded and this is the main use for this typeclass. -/
class ring_hom_isometric [semiring R₁] [semiring R₂] [has_norm R₁] [has_norm R₂]
  (σ : R₁ →+* R₂) : Prop :=
(is_iso : ∀ {x : R₁}, ∥σ x∥ = ∥x∥)

attribute [simp] ring_hom_isometric.is_iso

variables [semi_normed_ring R₁] [semi_normed_ring R₂] [semi_normed_ring R₃]

instance ring_hom_isometric.ids : ring_hom_isometric (ring_hom.id R₁) :=
⟨λ x, rfl⟩

end ring_hom_isometric


/-
Following the tradition of other programming languages,
gensym.lean contains the definition of an object to generate
fresh variable names for CNF encodings. Also included in this
file are the proofs of the freshness of variable generation.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import cnf.cnf
import data.list.basic
import data.nat.basic
import data.set.basic

open nat
open function
open prod
open list

variables {α : Type*}-- [decidable_eq α] [inhabited α]

/- Essentially, a gensym object only tracks a position along the natural number
   line. When provided with an injective function from the naturals to the
   boolean variable type, the gensym will provably generate fresh variables,
   with respect to those variables already generated.
-/
structure gensym (α : Type*) :=
(offset : nat)
(f : nat → α)
(f_inj : injective f)

namespace gensym

variables {f : nat → α} (hf : injective f) {a : α} (g : gensym α)

/-! # Gensym creation -/

/- Initial gensym that starts at 0 -/
def init : gensym α := { offset := 0, f := f, f_inj := hf }

/- We can create a gensym that doesn't ever generate variables in a list
   when we provide a bijection between α and the naturals. Simply start the
   gensym's offset at one more than the maximum element in the list. -/
def seed (fi : α → nat) (fi_inj : injective fi)
  (rinv : right_inverse f fi) : list α → gensym α
| [] := init hf
| l  := { offset := 1 + max_nat (map fi l), f := f, f_inj := hf }

/-! # fresh -/

-- Note: the operation below acts like a state monad
-- Future work on this file could convert gensym into a monad

/- Generates a new variable and returns an updated gensym -/
def fresh : (α × gensym α) :=
⟨g.f (g.offset), ⟨g.offset + 1, g.f, g.f_inj⟩⟩

@[simp] theorem fresh_offset :
  (fresh g).2.offset = g.offset + 1 := rfl

@[simp] theorem fresh_f : (fresh g).2.f = g.f := rfl

theorem fresh_var : (fresh g).1 = g.f g.offset := rfl

theorem fresh_f_injective : injective (fresh g).2.f :=
(fresh g).2.f_inj

/-! # nfresh -/

/- Generates a list of n new variables and returns the gensym at the end -/
def nfresh : gensym α → nat → (list α × gensym α)
| g 0       := ⟨[], g⟩
| g (n + 1) := let ⟨a, g₂⟩ := fresh g in
               prod.map (λ l, a :: l) id (nfresh g₂ n)

@[simp] theorem nfresh_zero : nfresh g 0 = ⟨[], g⟩ := rfl

@[simp] theorem nfresh_one : (nfresh g 1).2 = (fresh g).2 := rfl

@[simp] theorem nfresh_offset (n : nat) :
  (nfresh g n).2.offset = g.offset + n :=
begin
  induction n with n ih generalizing g,
  { refl },
  { simp [nfresh, fresh, ih, nat.add_succ, nat.succ_add] }
end

@[simp] theorem nfresh_f (n : nat) : (nfresh g n).2.f = g.f :=
begin
  induction n with n ih generalizing g,
  { refl },
  { simp only [nfresh, fresh, ih, id.def, prod_map] }
end

theorem nfresh_f_injective (n : nat) :
  injective (nfresh g n).2.f := (nfresh g n).2.f_inj

theorem nfresh_one_eq_fresh :
  nfresh g 1 = prod.map (λ a, [a]) id (fresh g) :=
by simp only [fresh, nfresh, map_mk, eq_self_iff_true]

theorem nfresh_succ_eq_nfresh_fresh (n : nat) :
  nfresh g (n + 1) = ⟨(fresh g).1 :: (nfresh (fresh g).2 n).1,
                      (fresh (nfresh g n).2).2⟩ :=
begin
  induction n with n ih generalizing g,
  { refl },
  { simp [nfresh, fresh, ih, nat.add_succ, nat.succ_add] }
end

theorem nfresh_succ_gensym_eq_fresh_nfresh_gensym (n : nat) :
  (nfresh g (n + 1)).2 = (fresh (nfresh g n).2).2 :=
by simp only [nfresh_succ_eq_nfresh_fresh]

theorem nfresh_succ_gensym_eq_nfresh_fresh_gensym (n : nat) :
  (nfresh g (n + 1)).2 = (nfresh (fresh g).2 n).2 :=
by simp [nfresh_succ_eq_nfresh_fresh, nfresh, fresh]

--theorem nfresh_succ_eq_fresh_nfresh (n : nat) :
--  nfresh g (n + 1) = ⟨(nfresh g n).1 ++ [(nfresh g n).2.fresh.1], (nfresh g n).2.fresh.2⟩ :=

/- nfresh can be split across two sets of calls -/
-- TODO later include both list and gensym objets in theorem
theorem nfresh_concat {n m₁ m₂ : nat} :
  n = m₁ + m₂ → (nfresh g n).2 = (nfresh (nfresh g m₁).2 m₂).2 :=
begin
  induction n with n ih generalizing m₁ m₂,
  { intro h,
    rw [nat.eq_zero_of_add_eq_zero_left h.symm,
      nat.eq_zero_of_add_eq_zero_right h.symm],
    refl },
  { cases m₂,
    { rw add_zero, rintro rfl, refl },
    { simp only [succ_eq_add_one, ← add_assoc],
      intro h,
      simp only [ih (nat.succ.inj h),
        nfresh_succ_gensym_eq_fresh_nfresh_gensym] } }
end

theorem length_list_nfresh (n : nat) :
  length (nfresh g n).1 = n :=
begin
  induction n with n ih generalizing g,
  { refl },
  { simp only [nfresh_succ_eq_nfresh_fresh, ih, length_cons] }
end

/-! # stock -/

/- Any gensym has a set of values it can produce
   A variable is in the stock if offset could reach it. -/
def stock : set α := { a | ∃ (n : nat), g.f (g.offset + n) = a }

-- TODO this can be cleaned up - right induction proof?
@[simp] theorem mem_stock {g : gensym α} :
  a ∈ g.stock ↔ a = g.fresh.1 ∨ a ∈ stock g.fresh.2 :=
begin
  split,
  { unfold stock,
    rw set.mem_set_of_eq,
    rintros ⟨n, hn⟩,
    induction n with n ih generalizing g,
    { rw add_zero at hn,
      exact or.inl hn.symm },
    { right,
      rw set.mem_set_of_eq,
      have : g.fresh.2.f (g.fresh.2.offset + n) = a,
      { rw [fresh_f, fresh_offset, add_assoc, ← succ_eq_one_add],
        exact hn },
      rcases ih this with (hm | hm),
      { simp [fresh] at hm,
        use 0,
        rw [fresh_f, fresh_offset, add_zero],
        exact hm.symm },
      { rw set.mem_set_of_eq at hm,
        rcases hm with ⟨m, hm⟩,
        use m + 1,
        simp at hm,
        simp,
        rw add_comm m 1,
        rw ← add_assoc _ 1 m,
        exact hm } } },
  { rintros (ha | ha),
    { unfold stock, rw set.mem_set_of_eq,
      simp [fresh] at ha,
      use 0, simp [ha] },
    { unfold stock at ha, rw set.mem_set_of_eq at ha,
      rcases ha with ⟨n, hn⟩,
      unfold stock, rw set.mem_set_of_eq,
      use n + 1,
      simp at hn,
      rw [add_comm n 1, ← add_assoc _ 1 n],
      exact hn } }
end

theorem fresh_mem_stock : g.fresh.1 ∈ g.stock :=
mem_stock.mpr (or.inl (refl g.fresh.1))

theorem fresh_fresh_mem_stock : g.fresh.2.fresh.1 ∈ g.stock :=
mem_stock.mpr (or.inr (fresh_mem_stock g.fresh.2))

theorem mem_stock_of_mem_fresh_stock {g : gensym α} :
  a ∈ g.fresh.2.stock → a ∈ g.stock :=
assume h, mem_stock.mpr (or.inr h)

theorem fresh_stock_subset : g.fresh.2.stock ⊆ g.stock :=
begin
  intros a ha,
  unfold stock at ha, rw set.mem_set_of_eq at ha,
  rcases ha with ⟨n, hn⟩,
  simp only [fresh_f, fresh_offset, add_assoc] at hn,
  unfold stock, rw set.mem_set_of_eq,
  use [1 + n, hn]
end

theorem fresh_not_mem_fresh_stock : g.fresh.1 ∉ g.fresh.2.stock :=
begin
  intro h,
  rcases mem_stock.mp h with hf | hf,
  { simp only [fresh] at hf,
    exact absurd (g.3.eq_iff.mp hf).symm (nat.succ_ne_self g.offset) },
  { unfold stock at hf,
    rw set.mem_set_of_eq at hf,
    rcases hf with ⟨n, hn⟩,
    simp [fresh] at hn,
    rw [add_assoc, ← succ_eq_add_one] at hn,
    exact absurd (g.3.eq_iff.mp hn) (ne_succ_add _ _) }
end

-- TODO can make one line
theorem fresh_stock_ssubset : stock g.fresh.2 ⊂ g.stock :=
begin
  apply (set.ssubset_iff_of_subset (fresh_stock_subset g)).mpr,
  use [g.fresh.1, fresh_mem_stock g, fresh_not_mem_fresh_stock g]
end

theorem nfresh_mem_stock {g : gensym α} {n : nat} : ∀ ⦃v⦄, v ∈ (g.nfresh n).1 → v ∈ g.stock :=
begin
  induction n with n ih generalizing g,
  { intros v hv, simp [nfresh] at hv, contradiction },
  { intros v hv,
    rw [nfresh_succ_eq_nfresh_fresh, mem_cons_iff] at hv,
    rcases hv with (rfl | hv),
    { exact fresh_mem_stock g },
    { exact fresh_stock_subset _ (ih hv) } }
end

theorem nfresh_stock_subset : ∀ (n : nat), (g.nfresh n).2.stock ⊆ g.stock :=
begin
  intro n,
  induction n with n ih,
  { rw nfresh_zero },
  { rw nfresh_succ_eq_nfresh_fresh,
    exact subset_trans (fresh_stock_subset _) ih }
end

-- # nth

def nth (g : gensym α) (n : nat) : α := g.f (n + g.offset)

theorem nth_ne_of_ne {i j : nat} : i ≠ j → ∀ (g : gensym α), nth g i ≠ nth g j :=
assume hne g, g.f_inj.ne_iff.mpr ((add_ne_add_left g.offset).mpr hne)

theorem eq_of_nth_eq {i j : nat} {g : gensym α} : nth g i = nth g j → i = j :=
assume h, (add_left_inj g.offset).mp (g.f_inj.eq_iff.mp h)

theorem nth_zero_eq_fresh : ∀ (g : gensym α), g.nth 0 = g.fresh.1 :=
by { intro g, rw [nth, fresh, zero_add] }

theorem nth_mem_stock : ∀ (g : gensym α) (n : nat), g.nth n ∈ g.stock :=
begin
  intros g n,
  rw [nth, stock],
  simp, use n, rw add_comm,
end

theorem nth_not_mem_nfresh_stock {g : gensym α} {i : nat} : ∀ ⦃a : α⦄,
  a ∈ (g.nfresh i).1 → a ∉ (g.nfresh i).2.stock :=
begin
  induction i with i ih generalizing g;
  intros a ha,
  { simp at ha, contradiction },
  { rw nfresh_succ_eq_nfresh_fresh at ha,
    unfold prod.fst at ha,
    rcases eq_or_mem_of_mem_cons ha with (rfl | hmem),
    { rw nfresh_succ_eq_nfresh_fresh,
      apply not_mem_subset (fresh_not_mem_fresh_stock g),
      unfold prod.snd,
      rw ← nfresh_succ_gensym_eq_fresh_nfresh_gensym g,
      rw nfresh_succ_gensym_eq_nfresh_fresh_gensym g,
      exact nfresh_stock_subset _ _ },
    { exact ih hmem } }
end

theorem nth_mem_nfresh_of_lt {i j : nat} : i < j → g.nth i ∈ (g.nfresh j).1 :=
begin
  induction j with j ih generalizing i g,
  { simp },
  { intro hlt,
    rw nfresh_succ_eq_nfresh_fresh,
    unfold prod.fst,
    cases i,
    { unfold fresh,
      unfold nth,
      rw [zero_add],
      exact mem_cons_self _ _ },
    { have : g.nth i.succ = g.fresh.2.nth i,
      { simp [nth, fresh, add_comm, add_assoc, succ_eq_add_one] },
      rw this,
      exact mem_cons_of_mem _ (ih _ (succ_lt_succ_iff.mp hlt)) } }
end

-- Disjointness
theorem forall_nth_not_mem_of_disjoint {g : gensym α} {l : set α} :
  disjoint g.stock l → ∀ (n : nat), g.nth n ∉ l :=
λ h n, set.disjoint_left.mp h (nth_mem_stock g n)

-- Coercion is silly
theorem forall_nth_not_mem_of_disjoint' {g : gensym α} {l : finset α} :
  disjoint g.stock l → ∀ (n : nat), g.nth n ∉ l :=
forall_nth_not_mem_of_disjoint

end gensym


/-
Copyright © 2019 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

structure {u v} groupoid_ {α : Type u} (γ : α → α → Sort v) : Sort (max (u+1) v)
structure {u v} groupoid {α : Type u} (γ : α → α → Sort v) extends groupoid_ γ : Sort (max (u+1) v) :=
(id (x : α) : γ x x)
(inv {x y : α} : γ x y → γ y x)
(comp {x y z : α} : γ x y → γ y z → γ x z)

definition groupoid.hid {α : Type*} {γ : α → α → Sort*} (Γ : groupoid γ) : Π {x y : α}, x = y → γ x y
| _ _ rfl := Γ.id _

definition groupoid.hcomp {α : Type*} {γ : α → α → Sort*} (Γ : groupoid γ) : Π {w x y z : α}, x = y → γ w x → γ y z → γ w z
| _ _ _ _ rfl g h := Γ.comp g h

class groupoid.is_lawful {α : Type*} {γ : α → α → Sort*} (Γ : groupoid γ) : Prop :=
(id_comp {x y : α} (g : γ x y) : Γ.comp (Γ.id x) g = g)
(comp_id {x y : α} (g : γ x y) : Γ.comp g (Γ.id y) = g)
(inv_comp {x y : α} (g : γ x y) : Γ.comp (Γ.inv g) g = Γ.id y)
(comp_inv {x y : α} (g : γ x y) : Γ.comp g (Γ.inv g) = Γ.id x)
(comp_assoc {w x y z : α} (f : γ w x) (g : γ x y) (h : γ y z) : Γ.comp (Γ.comp f g) h = Γ.comp f (Γ.comp g h))

namespace groupoid
variables {α : Type*} {γ : α → α → Sort*} (Γ : groupoid γ) [H : is_lawful Γ]
include H

lemma id_comp {x y : α} (g : γ x y) : Γ.comp (Γ.id x) g = g := is_lawful.id_comp Γ g

lemma comp_id {x y : α} (g : γ x y) : Γ.comp g (Γ.id y) = g := is_lawful.comp_id Γ g

lemma inv_comp {x y : α} (g : γ x y) : Γ.comp (Γ.inv g) g = Γ.id y := is_lawful.inv_comp Γ g

lemma comp_inv {x y : α} (g : γ x y) : Γ.comp g (Γ.inv g) = Γ.id x := is_lawful.comp_inv Γ g

lemma comp_assoc {w x y z : α} (f : γ w x) (g : γ x y) (h : γ y z) : Γ.comp (Γ.comp f g) h = Γ.comp f (Γ.comp g h) := is_lawful.comp_assoc Γ f g h

lemma comp_inv_cancel_left {x y z : α} (g : γ y x) (h : γ y z) : Γ.comp g (Γ.comp (Γ.inv g) h) = h :=
begin
rw [← comp_assoc],
rw [comp_inv],
rw [id_comp],
end

lemma inv_comp_cancel_right {x y z : α} (g : γ x y) (h : γ z y) : Γ.comp (Γ.comp g (Γ.inv h)) h = g :=
begin
rw [comp_assoc],
rw [inv_comp],
rw [comp_id],
end

lemma inv_comp_cancel_left {x y z : α} (g : γ x y) (h : γ y z) : Γ.comp (Γ.inv g) (Γ.comp g h) = h :=
begin
rw [← comp_assoc],
rw [inv_comp],
rw [id_comp],
end

lemma comp_inv_cancel_right {x y z : α} (g : γ x y) (h : γ y z) : Γ.comp (Γ.comp g h) (Γ.inv h) = g :=
begin
rw [comp_assoc],
rw [comp_inv],
rw [comp_id],
end

lemma eq_inv_of_comp_eq_id {x y : α} (g : γ x y) (h : γ y x) : Γ.comp g h = Γ.id x → g = Γ.inv h :=
begin
intro H,
transitivity Γ.comp g (Γ.comp h (Γ.inv h)),
rw [comp_inv],
rw [comp_id],
rw [← comp_assoc],
rw [H],
rw [id_comp],
end

lemma inv_eq_of_comp_eq_id {x y : α} (g : γ x y) (h : γ y x) : Γ.comp g h = Γ.id x → Γ.inv g = h :=
begin
intro H,
symmetry,
transitivity Γ.comp (Γ.inv g) (Γ.comp g h),
rw [← comp_assoc],
rw [inv_comp],
rw [id_comp],
rw [H],
rw [comp_id],
end

lemma inv_of_id {x : α} : Γ.inv (Γ.id x) = Γ.id x :=
begin
apply inv_eq_of_comp_eq_id,
rw [comp_id],
end

lemma inv_of_inv {x y : α} (g : γ x y) : Γ.inv (Γ.inv g) = g :=
begin
apply inv_eq_of_comp_eq_id,
rw [inv_comp],
end

lemma inv_of_comp {x y z : α} (g : γ x y) (h : γ y z): Γ.inv (Γ.comp g h) = Γ.comp (Γ.inv h) (Γ.inv g) :=
begin
apply inv_eq_of_comp_eq_id,
rw [← comp_assoc],
rw [comp_inv_cancel_right],
rw [comp_inv],
end

end groupoid


/-
Copyright (c) 2019 The Flypitch Project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Jesse Han, Floris van Doorn
-/
import .completion .language_extension .colimit

-- local attribute [instance, priority 0] classical.prop_decidable

open fol

universes u v
local infix ` →ᴸ `:10 := Lhom -- \^L

/- Temporarily putting this here because I can't get Lean to recognize Lhom in colimit.lean -/
namespace colimit

export directed_type
/- Below we define colimits of languages. These are just fieldwise (and then indexwise)
   colimits of types, so the proofs are very similar. -/

local infix ` ∘ `:60 := Lhom.comp

structure directed_diagram_language (D : (directed_type.{u})) : Type (max (u+1) (v+1)) :=
  (obj : D.carrier → (Language.{v}))
  (mor : ∀{x}, ∀{y}, D.rel x y → (obj x →ᴸ obj y))
  (h_mor : ∀{x} {y} {z} {f1 : D.rel x y} {f2 : D.rel y z} {f3 : D.rel x z},
            (mor f3) = (mor f2) ∘ (mor f1)) -- functoriality

export directed_diagram_language

/- Given a directed diagram of languages, we obtain two ℕ-indexed families of
   directed diagrams of types: one by restricting to functions and one by
   restricting to relations. -/
@[reducible]def diagram_functions {D : (directed_type)} {F : (directed_diagram_language D)} (n : ℕ) :
                      ((directed_diagram D)) :=
begin
  refine ⟨by {intro x, exact (obj F x).functions n},_,_⟩,
  {intros x y edge, have := (F.mor edge).on_function, exact this },
  {intros, simp only [], have := F.h_mor, have := @this x y z f1 f2 f3, rw[this]},
end

@[reducible]def diagram_relations {D : (directed_type)} {F : (directed_diagram_language D)} (n : ℕ) :
                      ((directed_diagram D)) :=
begin
  refine ⟨by {intro x, exact (obj F x).relations n},_,_⟩,
  {intros x y edge, have := (F.mor edge).on_relation, exact @this n},
  {intros, simp only [], have := F.h_mor, have := @this x y z f1 f2 f3, rw[this]},
end

def coproduct_of_directed_diagram_language {D : (directed_type : Type (u+1)) }
    (F : (directed_diagram_language D :  Type (max (u+1) (v+1)))) :  Language :=
⟨λn, coproduct_of_directed_diagram (@diagram_functions D F n),
  λn, coproduct_of_directed_diagram (@diagram_relations D F n)⟩

def colimit_language {D : (directed_type : Type (u+1)) } (F : (directed_diagram_language D)) : Language :=
⟨λn, @quotient (coproduct_of_directed_diagram (@diagram_functions D F n))
  ⟨germ_relation (diagram_functions n), germ_equivalence (diagram_functions n)⟩,
λn, @quotient (coproduct_of_directed_diagram (@diagram_relations D F n))
  ⟨germ_relation (diagram_relations n), germ_equivalence (diagram_relations n)⟩⟩

/- The canonical map of languages is the pointwise canonical map of colimits of types -/
def canonical_map_language {D} {F : directed_diagram_language D} (i : D.carrier) :
                           (F.obj i) →ᴸ colimit_language F :=
⟨λ n, function.comp (by apply quotient.mk) (@canonical_inclusion_coproduct D (diagram_functions n) i),
λ n, function.comp (by apply quotient.mk) (@canonical_inclusion_coproduct D (diagram_relations n) i)⟩

-- structure cocone_language' {D} (F : directed_diagram_language D) :=
--   (vertex : Language)
--   (cocone_functions : ∀{n}, @colimit.cocone D (@diagram_functions D F n)
-- would need extra hypotheses that for every n, the vertex of the cocone_functions (resp. relations)
-- is equal to vertex.functions (resp. relations)
-- maybe that would have been easier to work with

structure cocone_language {D} (F : directed_diagram_language D) :=
  (vertex : Language)
  (map : Π i : D.carrier, F.obj i →ᴸ vertex)
  (h_compat : ∀{i}, ∀{j}, Π h : D.rel i j, (map i ) = (map j) ∘ (F.mor h))

export cocone_language

def cocone_of_colimit_language {D} (F : directed_diagram_language D) : cocone_language F :=
begin
  refine ⟨colimit_language F, canonical_map_language, _⟩, intros i j H, fapply Lhom.Lhom_funext,
  all_goals{fapply funext, intro n,
  simp only [quotient.eq,(≈),canonical_map_language,function.comp], have h_refl : D.rel j j,
  by apply D.h_reflexive, -- refine ⟨j,F.mor H x, H, h_refl, rfl, _⟩,
  fapply funext, intro x, simp only [quotient.eq,(≈),canonical_map_language,function.comp],
  },
  {refine ⟨j,(F.mor H).on_function x, H, h_refl, rfl, _⟩,
  change (function.comp ((diagram_functions n).mor h_refl) begin fapply Lhom.on_function, exact @mor D F i j H, end) x = (F.mor H).on_function x,
   have := Lhom.comp_on_function' (F.mor h_refl) (F.mor H) n, rw[<-this,<-F.h_mor]},
  {  refine ⟨j,(F.mor H).on_relation x, H, h_refl, rfl, _⟩,
    change (function.comp ((diagram_relations n).mor h_refl) begin fapply Lhom.on_relation, exact @mor D F i j H, end) x = (F.mor H).on_relation x,
   have := Lhom.comp_on_relation' (F.mor h_refl) (F.mor H) n, rw[<-this,<-F.h_mor]}
end

/- Given a cocone V over a diagram D, return the canonical map colim D → V-/
def universal_map_language {D} {F : directed_diagram_language D} {V : cocone_language F} : colimit_language F →ᴸ (V.vertex) :=
begin
  split, all_goals{intro n,
  fapply quotient.lift},

{exact λp, begin fapply @Lhom.on_function, exact F.obj p.fst, exact @map D F V p.fst, exact p.snd end},
  {intros p q H, rcases p with ⟨i,x⟩, rcases q with ⟨j,y⟩, simp only *,
   simp[(≈), germ_relation] at H, rcases H with ⟨k,z,⟨f1, H1⟩,f2,H2⟩,
   change (V.map i).on_function x = (V.map j).on_function y, have : (V.map i).on_function x = (V.map k).on_function ((F.mor f1).on_function x),
   simp only [V.h_compat f1, eq_self_iff_true, function.comp_app],
   have : (V.map j).on_function y = (V.map k).on_function ((F.mor f2).on_function y),
   simp only [V.h_compat f2, eq_self_iff_true, function.comp_app],
   simp only [*, eq_self_iff_true]},

{exact λp, begin fapply @Lhom.on_relation, exact F.obj p.fst, exact @map D F V p.fst, exact p.snd end},
  {intros p q H, rcases p with ⟨i,x⟩, rcases q with ⟨j,y⟩, simp only *,
   simp[(≈), germ_relation] at H, rcases H with ⟨k,z,⟨f1, H1⟩,f2,H2⟩,
   change (V.map i).on_relation x = (V.map j).on_relation y, have : (V.map i).on_relation x = (V.map k).on_relation ((F.mor f1).on_relation x),
   simp only [V.h_compat f1, eq_self_iff_true, function.comp_app],
   have : (V.map j).on_relation y = (V.map k).on_relation ((F.mor f2).on_relation y),
   simp only [V.h_compat f2, eq_self_iff_true, function.comp_app],
   simp only [*, eq_self_iff_true]},
end

namespace omega_colimit_language
/- Facts about directed colimits indexed by ℕ'. -/
def diagram.mk.map {F : ℕ → Language} {h_succ : ∀{i : ℕ}, F i →ᴸ F (i+1)} : Π (x y : ℕ), x ≤ y → (F x →ᴸ F y)
| x 0 h := by {rw[nat.eq_zero_of_le_zero h], exact ⟨λn, id, λn, id⟩}
| x (y+1) h := by {by_cases x = y + 1, rw[h], exact ⟨λn, id, λn, id⟩, refine h_succ ∘  _,
                  apply diagram.mk.map, apply nat.le_of_le_and_ne_succ, repeat{assumption}}

--TODO(jesse) finish converting this to language versions and refactor henkin_language_chain
-- @[simp]lemma diagram.mk.map_self_id {F : ℕ → Type*} {h_succ : ∀(i : ℕ), F i → F (i+1)} (x : ℕ) :
--                   @diagram.mk.map F @h_succ x x (by constructor) = id :=
-- by {induction x, tidy, simp[diagram.mk.map,*], refl}

-- /- If the successive maps of h_succ are injective, then all their compositions are injective -/
-- lemma diagram.mk.map_inj {F : ℕ → Type*} {h_succ : ∀(i : ℕ), F i → F (i+1)} {h_inj : ∀ {i : ℕ}, function.injective (@h_succ i )} (x y : ℕ) (h : x ≤ y) : function.injective (@diagram.mk.map F h_succ x y h) :=
-- begin
--   induction y,
--     {have : x = 0, by exact nat.eq_zero_of_le_zero h, dsimp[*,diagram.mk.map], finish},
--     by_cases x = y_n + 1,
--       {dsimp[*, diagram.mk.map], finish},
--     have : x ≤ y_n, by {apply nat.le_of_le_and_ne_succ, repeat{assumption}},
--     simp[*, diagram.mk.map], apply function.injective_comp, apply h_inj, apply y_ih
-- end

-- -- /- Given a ℕ-indexed family of types and a way of assigning maps between successive objects
-- --    in this family, return the induced directed_diagram over ℕ'. -/
-- def diagram.mk(F : ℕ → Type*) (h_succ :∀{i : ℕ}, F i → F (i+1)) : directed_diagram ℕ' :=
-- begin
-- refine ⟨F, by {apply diagram.mk.map, assumption}, _⟩,
--   intros x y z H1 H2 H3,
--     induction z, induction y, induction x,
--     dsimp[diagram.mk.map], refl,
--      by {exfalso, fapply nat.succ_ne_zero, exact x_n, apply (nat.le_zero_iff).mp, assumption},
--      by {exfalso, fapply nat.succ_ne_zero, exact y_n, apply (nat.le_zero_iff).mp, assumption},
--      by_cases y = z_n+1, subst h;
--        by_cases x = z_n+1;
--        {repeat{dsimp[diagram.mk.map], simp*, refl}},
--      by_cases x = z_n+1,
--        {exfalso, have : y < z_n+1, by {fapply nat.lt_of_le_and_ne,
--          repeat{assumption}}, dsimp at *, linarith},
--        {have h_x : x ≤ z_n; have h_y : y ≤ z_n,
--          all_goals{try{apply nat.le_of_le_and_ne_succ, repeat{assumption}}},
--         have := @z_ih h_y h_x,
--         dsimp[diagram.mk.map], dedup,
--         simp only [h, h_1, dif_neg, not_false_iff, colimit.nat.le_of_le_and_ne_succ],
--         rw[this]}
-- end

end omega_colimit_language

end colimit

open colimit

open omega_colimit

/- The Henkin construction consists of the following:
   1. Constructing a ℕ-indexed chain of languages and theories, and
   2. Taking the union of that chain. -/

/- To define henkin_language_step, there is an inductive type of new function
   function symbols, comprising an inclusion constructor for the symbols
   from L, and a witness constructor which introduces witnesses for every
   bounded_formula 1-/
inductive henkin_language_functions (L : Language.{u}) : ℕ → Type u
  | inc : ∀ {n}, L.functions n → henkin_language_functions n
  | wit : bounded_formula L 1 → henkin_language_functions 0

open henkin_language_functions

/- The basic step of the Henkin construction on languages.
   Given a language L, return a language L' with constants
   witnessing all bounded_formula 1-/
@[reducible]def henkin_language_step (L : Language.{u}) : Language.{u} :=
  ⟨henkin_language_functions L, L.relations⟩

def wit' {L : Language} : bounded_formula L 1 → (henkin_language_step L).constants := wit

def henkin_language_inclusion {L : Language} : L →ᴸ henkin_language_step L :=
  ⟨λ n f, inc f, λn, id⟩

lemma henkin_language_inclusion_inj {L : Language} : Lhom.is_injective (@henkin_language_inclusion L) :=
begin
  split, all_goals{intro n, intros x y H, try{exact H}},
  fapply @henkin_language_functions.inc.inj_arrow,
  exact L, exact n, exact x, exact y, exact H, simp only [imp_self]
end

/- The basic step of the Henkin construction on theories.
   Given an L-theory T, return an L'-theory T' which is T expanded by
   sentences saying that the new witnesses are witnesses. -/
@[reducible]def wit_property {L : Language} (f : bounded_formula L 1) (c : L.constants) :
  sentence L :=
(∃'f) ⟹ f[bd_const c/0]

open fol.Lhom
def henkin_theory_step {L} (T : Theory L) : Theory $ henkin_language_step L :=
Theory_induced henkin_language_inclusion T ∪
(λ f : bounded_formula L 1,
  wit_property (henkin_language_inclusion.on_bounded_formula f) (wit' f)) '' (set.univ : set $ bounded_formula L 1)

def is_consistent_henkin_theory_step {L} {T : Theory L} (hT : is_consistent T) :
  is_consistent (henkin_theory_step T) :=
begin
  refine eq.mp _ (is_consistent_extend hT henkin_language_inclusion_inj
    (λf, (∃' f).cast1 ⟹ f) _ wit _ _),
  { congr1, congr1, apply set.image_congr', intro f, ext,
    simp [wit_property, wit', -fst_ex], rw [←on_bounded_formula_fst, subst_sentence_irrel], refl },
  { intro f, apply falsumE, apply impE (∃' f.fst),
    { apply impI, apply impE _ axm2, apply exE axm1,
      apply exI &0, rw [lift_subst_formula_cancel], apply impI axm2 },
    { apply falsumE, apply impE _ axm2, apply exI &0,
      apply impI, apply exfalso, apply impE _ axm2,
      rw [bounded_preformula.cast1_fst, subst_sentence_irrel], exact axm1 }},
  { intros f f' h, cases h, refl },
  { intro f, intro h, rcases h with ⟨f', hf'⟩, cases hf' }
end

@[reducible]def henkin_language_chain_objects {L : Language} : ℕ → Language
  | 0 := L
  | (n+1) := henkin_language_step (henkin_language_chain_objects n)

@[simp]lemma obvious {L : Language} {i : ℕ} : henkin_language_functions (@henkin_language_chain_objects L i) 0 = (@henkin_language_chain_objects L (i+1)).constants :=
by refl

local infix ` ∘ `:60 := Lhom.comp

def henkin_language_chain_maps (L : Language): Π x y, x ≤ y → (@henkin_language_chain_objects L x →ᴸ @henkin_language_chain_objects L y)
| x 0 H := by {have : x = 0, by exact nat.eq_zero_of_le_zero H, rw[this], apply Lhom.id}
| x (y+1) H := by {by_cases x = y + 1, rw[h], fapply Lhom.id,
               refine @henkin_language_inclusion (@henkin_language_chain_objects L y) ∘ _,
               fapply henkin_language_chain_maps,
               fapply nat.le_of_le_and_ne_succ, exacts [H, h]}

lemma henkin_language_chain_maps_inj (L : Language) : Π x y : ℕ, Π (h : x ≤ y), Lhom.is_injective (henkin_language_chain_maps L x y h) :=
begin
  intros i j h, split, swap,
  {induction j,
    {have : i  = 0, by exact nat.eq_zero_of_le_zero h, subst this,
    intros n x y H, exact H},
    {by_cases i = (j_n + 1), dedup,
     {subst h_1, rw[henkin_language_chain_maps], simp*,
     intros n x y H, exact H},
     {have : i ≤ j_n, by {apply nat.le_of_le_and_ne_succ, repeat{assumption}},
     have ih := j_ih this, show ℕ, exact i,
     rw[henkin_language_chain_maps], simp only [*, dif_neg, not_false_iff],
     intro n, fapply function.injective_comp, fapply henkin_language_inclusion_inj.on_relation,
     change function.injective (Lhom.on_relation (henkin_language_chain_maps L i j_n this)),
     simp only *,}}
  },
  {induction j,
    {have : i  = 0, by exact nat.eq_zero_of_le_zero h, subst this,
    intros n x y H, exact H},
    {by_cases i = (j_n + 1), dedup,
     {subst h_1, rw[henkin_language_chain_maps], simp*,
     intros n x y H, exact H},
     {have : i ≤ j_n, by {apply nat.le_of_le_and_ne_succ, repeat{assumption}},
     have ih := j_ih this, show ℕ, exact i,
     rw[henkin_language_chain_maps], simp only [*, dif_neg, not_false_iff],
     intro n, fapply function.injective_comp, fapply henkin_language_inclusion_inj.on_function,
     change function.injective (Lhom.on_function (henkin_language_chain_maps L i j_n this)),
     simp only *,}}},
end

/- Given a language, iterate henkin_language_step, returning this data in the form
   of a directed diagram of types indexed by ℕ' -/
def henkin_language_chain {L : Language} : (directed_diagram_language directed_type_of_nat) :=
begin
  refine ⟨_, _, _⟩,
  {exact @henkin_language_chain_objects L},
  {change Π {x y : ℕ},
    x ≤ y → (henkin_language_chain_objects x →ᴸ henkin_language_chain_objects y),
    intros x y H, fapply henkin_language_chain_maps, exact H},
  {change ∀ {x y z : ℕ} {f1 :  x ≤ y} {f2 :  y ≤ z}
  {f3 :  x ≤ z},
    henkin_language_chain_maps L x z _ =
    henkin_language_chain_maps L y z _ ∘
    henkin_language_chain_maps L x y _,
    intros x y z f1 f2 f3,
    induction z,
      {have this1 : x = 0, by exact nat.eq_zero_of_le_zero f3,
      have this2 : y = 0, by exact nat.eq_zero_of_le_zero f2,
       subst this1, subst this2, refl},
      { unfold henkin_language_chain_maps, by_cases y = z_n + 1, simp*, subst h, by_cases x = z_n+1, simp*, subst h,
       unfold henkin_language_chain_maps, simp, refl,
       {simp*,
       have : eq.mpr _ (Lhom.id (henkin_language_chain_objects (z_n + 1))) ∘ henkin_language_chain_maps L x (z_n + 1) f1 = (Lhom.id (henkin_language_chain_objects (z_n + 1))) ∘ henkin_language_chain_maps L x (z_n + 1) f1, by refl, rw[this],
       have : Lhom.id (henkin_language_chain_objects (z_n + 1)) ∘ henkin_language_chain_maps L x (z_n + 1) f1 =  henkin_language_chain_maps L x (z_n + 1) f1,
       by simp only [eq_self_iff_true, fol.Lhom.id_is_left_identity],
       rw[this], unfold henkin_language_chain_maps, simp*,
         },
       {by_cases x = z_n+1,
         {simp*, have : y < z_n+1, by {fapply nat.lt_of_le_and_ne,
         repeat{assumption}}, exfalso, linarith},
         {simp*}
       }
    }
}
end

@[simp]lemma id_of_self_map (L : Language) : ∀ k, (henkin_language_chain_maps L k k (le_refl k)) = Lhom.id ((@henkin_language_chain L).obj k)
| 0 := by refl
| (n+1) := by {dsimp[henkin_language_chain_maps], simp*, refl}

@[simp]lemma henkin_language_inclusion_chain_map {i} {L : Language} : henkin_language_inclusion = henkin_language_chain_maps L i (i + 1) (by simp[nat.le_succ]) :=
begin
  unfold henkin_language_chain_maps, have : i ≠ i + 1, by {induction i, tidy},
  simp[this], rw[@Lhom.id_is_right_identity ((@henkin_language_chain L).obj i)]
end

def L_infty (L) : Language :=
   colimit_language $ @henkin_language_chain L

/-- For every n : ℕ, return the canonical inclusion L_n → L_infty  --/
def henkin_language_canonical_map {L : Language} (m : ℕ) : (@henkin_language_chain L).obj m →ᴸ (@L_infty L) := by apply canonical_map_language

@[simp]lemma henkin_language_canonical_map_inj {L : Language} (m : ℕ) : Lhom.is_injective $ @henkin_language_canonical_map L m :=
begin
  split,

  {intro n, unfold henkin_language_canonical_map canonical_map_language Lhom.on_function,
  have := @canonical_map_inj_of_transition_maps_inj directed_type_of_nat (@diagram_functions directed_type_of_nat (@henkin_language_chain L) n), unfold canonical_map at this, apply this,intros i j H, dsimp[diagram_functions, henkin_language_chain],
  fapply ((henkin_language_chain_maps_inj) L i j H).on_function},

  {intro n, unfold henkin_language_canonical_map canonical_map_language Lhom.on_relation,
  have := @canonical_map_inj_of_transition_maps_inj directed_type_of_nat (@diagram_relations directed_type_of_nat (@henkin_language_chain L) n), unfold canonical_map at this, apply this,intros i j H, dsimp[diagram_relations, henkin_language_chain],
  fapply ((henkin_language_chain_maps_inj) L i j H).on_relation}
end

/- To prove that T_infty is Henkin, we'll have to exhibit a witnessing function of the form
  wit : bounded_formula 1 → L_infty.constants.

  To do this, we have to recursively go through formulas and terms and show that for every
  formula, there exists some N such that all the symbols in that formula were contained in L_N,
  and therefore, the wit function for L_N introduces the constant we want.

  The natural way to proceed is to define the induced colimit on bounded_formulas, etc.

  Then, we can define the required wit function by taking a bounded formula, picking a
  representative from stage N, applying the wit function from stage N to get something in
  stage N+1, and then pushing it up to L_infty. -/

/- In what follows, "l" is always pre(whatever) level, "k" is always chain index,
   and "n" is always the bound in bounded_(whatever)-/

def henkin_term_chain {L : Language} (l : ℕ) : directed_diagram ℕ' :=
begin
  refine ⟨λ k, preterm (@henkin_language_chain_objects L k) l, _, _⟩,
  {intros x y H, apply Lhom.on_term, apply @henkin_language_chain_maps L, exact H},
  {intros x y z f1 f2 f3, dsimp only [*],
   have : (henkin_language_chain_maps L x z f3) =
   (henkin_language_chain_maps L y z f2) ∘ (henkin_language_chain_maps L x y f1),
   fapply henkin_language_chain.h_mor, simp*}
end

def henkin_formula_chain {L : Language} (l : ℕ) : directed_diagram ℕ' :=
begin
  refine ⟨λ k, preformula (@henkin_language_chain_objects L k) l, _, _⟩,
  {intros x y H, apply Lhom.on_formula, apply @henkin_language_chain_maps L, exact H},
  {intros x y z f1 f2 f3, dsimp only [*],
   have : (henkin_language_chain_maps L x z f3) =
   (henkin_language_chain_maps L y z f2) ∘ (henkin_language_chain_maps L x y f1),
   fapply henkin_language_chain.h_mor, simp*}
end

def henkin_bounded_term_chain {L : Language} (n l : ℕ) : directed_diagram ℕ' :=
begin
  refine ⟨λ k, bounded_preterm (@henkin_language_chain_objects L k) n l, _, _⟩,
  {intros x y H, apply Lhom.on_bounded_term, apply @henkin_language_chain_maps L, exact H},
  {intros x y z f1 f2 f3, dsimp only [*],
   have : (henkin_language_chain_maps L x z f3) =
   (henkin_language_chain_maps L y z f2) ∘ (henkin_language_chain_maps L x y f1),
   fapply henkin_language_chain.h_mor, rw[this, Lhom.comp_on_bounded_term]}
end

@[reducible] def henkin_bounded_term_chain' {L : Language} : directed_diagram ℕ' := @henkin_bounded_term_chain L 1 0

def henkin_bounded_formula_chain {L : Language} (n l : ℕ) : directed_diagram ℕ' :=
begin
  refine ⟨λ k, bounded_preformula (@henkin_language_chain_objects L k) n l, _, _⟩,
  {intros x y H, apply Lhom.on_bounded_formula, apply @henkin_language_chain_maps L, exact H},
  {intros x y z f1 f2 f3, dsimp only [*],
   have : (henkin_language_chain_maps L x z f3) =
   (henkin_language_chain_maps L y z f2) ∘ (henkin_language_chain_maps L x y f1),
   fapply henkin_language_chain.h_mor, rw[this, Lhom.comp_on_bounded_formula]}
end

@[reducible]def henkin_bounded_formula_chain' {L : Language} : directed_diagram ℕ' := @henkin_bounded_formula_chain L 1 0

/- L_infty := colim L_n is naturally a cocone over the diagram of languages -/
def cocone_of_L_infty {L : Language} : cocone_language (@henkin_language_chain L) :=
  by apply cocone_of_colimit_language

def cocone_of_term_L_infty {L : Language } (l : ℕ) : cocone (@henkin_term_chain L l) :=
begin
  refine ⟨preterm (L_infty L) l,_,_⟩,
  {intro i, fapply Lhom.on_term, fapply henkin_language_canonical_map},
  {intros i j H, dsimp[henkin_term_chain],
  rw[<-Lhom.comp_on_term],
  have : henkin_language_canonical_map i = (henkin_language_canonical_map j ∘ henkin_language_chain_maps L i j H), swap, rw[this],
  {have := (@cocone_of_L_infty L).h_compat, tidy}}
end

def cocone_of_formula_L_infty {L : Language } (l : ℕ) : cocone (@henkin_formula_chain L l) :=
begin
  refine ⟨preformula (L_infty L) l,_,_⟩,
  {intro i, fapply Lhom.on_formula, fapply henkin_language_canonical_map},
  {intros i j H, dsimp[henkin_formula_chain],
  rw[<-Lhom.comp_on_formula],
  have : henkin_language_canonical_map i = (henkin_language_canonical_map j ∘ henkin_language_chain_maps L i j H), swap, rw[this],
  {have := (@cocone_of_L_infty L).h_compat, tidy}}
end

def cocone_of_bounded_term_L_infty {L : Language } (n l : ℕ) : cocone (@henkin_bounded_term_chain L n l) :=
begin
  refine ⟨bounded_preterm (L_infty L) n l,_,_⟩,
  {intro i, fapply Lhom.on_bounded_term, fapply henkin_language_canonical_map},
  {intros i j H, dsimp[henkin_bounded_term_chain],
  rw[<-Lhom.comp_on_bounded_term],
  have : henkin_language_canonical_map i = (henkin_language_canonical_map j ∘ henkin_language_chain_maps L i j H), swap, rw[this],
  {have := (@cocone_of_L_infty L).h_compat, tidy}}
end

def cocone_of_bounded_formula_L_infty {L : Language } (n l : ℕ) : cocone (@henkin_bounded_formula_chain L n l) :=
begin
  refine ⟨bounded_preformula (L_infty L) n l,_,_⟩,
  {intro i, fapply Lhom.on_bounded_formula, fapply henkin_language_canonical_map},
  {intros i j H, dsimp[henkin_bounded_formula_chain],
  rw[<-Lhom.comp_on_bounded_formula],
  have : henkin_language_canonical_map i = (henkin_language_canonical_map j ∘ henkin_language_chain_maps L i j H), swap, rw[this],
  {have := (@cocone_of_L_infty L).h_compat, tidy}}
end

/- bounded_formula (L_infty L) 1 is naturally a cocone over the diagram of bounded_formulas -/
def cocone_of_bounded_formula'_L_infty {L : Language} : cocone (@henkin_bounded_formula_chain' L) :=
begin
  refine ⟨bounded_formula (L_infty L) 1,_,_⟩,
  {intro i, fapply Lhom.on_bounded_formula, fapply henkin_language_canonical_map},
  {intros i j H, dsimp[henkin_bounded_formula_chain', henkin_bounded_formula_chain],
  rw[<-Lhom.comp_on_bounded_formula],
  have : henkin_language_canonical_map i = (henkin_language_canonical_map j ∘ henkin_language_chain_maps L i j H), swap, rw[this],
  {have := (@cocone_of_L_infty L).h_compat, tidy}}
end

def term_comparison {L : Language} (l) : colimit (@henkin_term_chain L l) → preterm (L_infty L) l :=
begin
  change colimit (@henkin_term_chain L l)  → (@cocone_of_term_L_infty L l).vertex,
  apply colimit.universal_map
end

def formula_comparison {L : Language} (l) : colimit (@henkin_formula_chain L l) → preformula (L_infty L) l :=
begin
  change colimit (@henkin_formula_chain L l)  → (@cocone_of_formula_L_infty L l).vertex,
  apply colimit.universal_map
end

def bounded_term_comparison {L : Language} (n l) : colimit (@henkin_bounded_term_chain L n l) → bounded_preterm (L_infty L) n l :=
begin
  change colimit (@henkin_bounded_term_chain L n l)  → (@cocone_of_bounded_term_L_infty L n l).vertex,
  apply colimit.universal_map
end

@[reducible]def bounded_term'_comparison {L : Language}  : colimit (@henkin_bounded_term_chain' L) → bounded_term (L_infty L) 1 := @bounded_term_comparison L 1 0

def bounded_formula_comparison {L : Language} (n l) : colimit (@henkin_bounded_formula_chain L n l) → bounded_preformula (L_infty L) n l :=
begin
  change colimit (@henkin_bounded_formula_chain L n l)  → (@cocone_of_bounded_formula_L_infty L n l).vertex,
  apply colimit.universal_map
end

@[reducible]def bounded_formula'_comparison {L : Language} : colimit (@henkin_bounded_formula_chain' L) → bounded_formula (L_infty L) 1 := @bounded_formula_comparison L 1 0

-- to proceed, need to show that bounded_formula_comparison, as we've defined it,
-- commutes with operations on bounded formulas -- so we need to generalize from
-- bounded_formula 1 to bounded_formula n, and prove colimit statements for terms, etc
-- to complete the structural recursion

/- The universal map from colimit preterm L_n → preterm L_infty is a bijection -/
-- TODO(jesse) refactor with new colimit lemmas
lemma term_comparison_bijective {L : Language} (l) : function.bijective (@term_comparison L l) :=
begin
  refine ⟨_,_⟩,
  {{unfold term_comparison id, fapply universal_map_inj_of_components_inj,
  change ∀ i : ℕ, function.injective ((cocone_of_term_L_infty l).map i),
  dsimp[cocone_of_term_L_infty],  intro m,
  fapply Lhom.on_term_inj (@henkin_language_canonical_map_inj L m)},},
  {intro f, induction f,
    {refine ⟨(by {fapply canonical_map, by {change ℕ, exact 0}, exact var f}), by split⟩},
    {have W := germ_rep f_f, rcases W with ⟨⟨i,x⟩, Hx⟩, fapply exists.intro,
     fapply canonical_map i, fapply func, exact x, rw[<-Hx], refl},
    {rcases f_ih_t with ⟨t, Ht⟩, rcases f_ih_s with ⟨s,Hs⟩, have Wt := germ_rep t,
    have Ws := germ_rep s, rcases Wt with ⟨⟨i,x_t⟩, Hxt⟩, rcases Ws with ⟨⟨j, x_s⟩, Hxs⟩,
    let x_t' : (henkin_term_chain (f_l + 1)).obj (i+j),
      fapply (henkin_term_chain (f_l + 1)).mor, exact i,
      simp only [ℕ', directed_type.rel, id.def, zero_le, le_add_iff_nonneg_right],
      exact x_t,
    let x_s' : (henkin_term_chain 0).obj (i+j),
      fapply (henkin_term_chain 0).mor, exact j,
      simp only [ℕ', directed_type.rel, zero_le, le_add_iff_nonneg_left],
      exact x_s,
    have Hxt' : ⟦(⟨i+j,x_t'⟩ : coproduct_of_directed_diagram $ henkin_term_chain (f_l + 1))⟧ = t,
      {rw[<-Hxt], simp[(≈), germ_relation], refine ⟨(i+j),x_t',⟨by simp,_⟩,_⟩,
       dsimp[henkin_term_chain, henkin_language_chain_maps], let k := i + j,
       simp only [id_of_self_map], apply Lhom.id_term,
       fapply exists.intro, simp only [zero_le, le_add_iff_nonneg_right]},
    have Hxs' : ⟦(⟨i+j,x_s'⟩ : coproduct_of_directed_diagram $ henkin_term_chain 0)⟧ = s,
    {{rw[<-Hxs], simp[(≈), germ_relation], refine ⟨(i+j),x_s',⟨by simp,_⟩,_⟩,
       dsimp[henkin_term_chain, henkin_language_chain_maps], let k := i + j,
       simp only [id_of_self_map], apply Lhom.id_term,
       fapply exists.intro, simp only [zero_le, le_add_iff_nonneg_left]},},
    fapply exists.intro, fapply canonical_map, change ℕ, exact (i + j),
    fapply app, exact x_t', exact x_s', rw[<-Ht, <-Hs, <-Hxt', <-Hxs'], refl},}
end

/- At some point, I should write out explicitly the fact that all the comparison maps
   structurally recurse -/
lemma formula_comparison_bijective {L : Language} (l) : function.bijective (@formula_comparison L l) :=
begin
  refine ⟨_,_⟩,
  {{unfold formula_comparison id, fapply universal_map_inj_of_components_inj,
  change ∀ i : ℕ, function.injective ((cocone_of_formula_L_infty l).map i),
  dsimp[cocone_of_formula_L_infty],  intro m,
  fapply Lhom.on_formula_inj (@henkin_language_canonical_map_inj L m)},},
  {intro f, induction f,
  {refine ⟨(by {fapply canonical_map, by {change ℕ, exact 0}, exact falsum}), by split⟩},
  {
    rcases (term_comparison_bijective 0).right f_t₁ with ⟨t₁, H₁⟩, rcases (term_comparison_bijective 0).right f_t₂ with ⟨t₂, H₂⟩,
    rcases germ_rep t₁ with ⟨⟨i,x⟩,Hx⟩, rcases germ_rep t₂ with ⟨⟨j,y⟩,Hy⟩,
    fapply exists.intro, fapply canonical_map, exact i+j, fapply equal,
    exact push_to_sum_r x j, exact push_to_sum_l y i,
    rw[<-H₁, <-H₂,<-Hx, <-Hy, <-canonical_map_quotient, same_fiber_as_push_to_r x j ,<-canonical_map_quotient, same_fiber_as_push_to_l y i],
    simpa only},
  {have x := germ_rep f_R, rcases x with ⟨⟨i,x⟩,H⟩, fapply exists.intro, have R' := rel x,
   exact ⟦⟨i,R'⟩⟧, tidy},
  {rcases f_ih with ⟨t₁, H₁⟩,
   rcases (term_comparison_bijective 0).right f_t with ⟨t₂, H₂⟩,
   rcases germ_rep t₁ with ⟨⟨i,x⟩,Hx⟩, rcases germ_rep t₂ with ⟨⟨j,y⟩,Hy⟩,
   fapply exists.intro, fapply canonical_map, exact i+j, fapply apprel,
   exact push_to_sum_r x j, exact push_to_sum_l y i,
    rw[<-H₁, <-H₂,<-Hx, <-Hy, <-canonical_map_quotient, same_fiber_as_push_to_r x j ,<-canonical_map_quotient, same_fiber_as_push_to_l y i],
    simpa only},
  {rcases f_ih_f₁ with ⟨t₁, H₁⟩, rcases f_ih_f₂ with ⟨t₂, H₂⟩,
   rcases germ_rep t₁ with ⟨⟨i,x⟩,Hx⟩, rcases germ_rep t₂ with ⟨⟨j,y⟩,Hy⟩,
   fapply exists.intro, fapply canonical_map, exact (i+j), fapply imp,
   exact push_to_sum_r x j, exact push_to_sum_l y i,
    rw[<-H₁, <-H₂,<-Hx, <-Hy, <-canonical_map_quotient, same_fiber_as_push_to_r x j ,<-canonical_map_quotient, same_fiber_as_push_to_l y i],
    simpa only},
  {rcases f_ih with ⟨t₁, H₁⟩,
   rcases germ_rep t₁ with ⟨⟨i,x⟩,Hx⟩,
   fapply exists.intro, fapply canonical_map, exact i, fapply all,
   exact x, rw[<-H₁, <-Hx], simpa only}}
end

@[simp]lemma bounded_term_comparison_bijective {L : Language} (n l) : function.bijective (@bounded_term_comparison L n l) :=
begin
refine ⟨_,_⟩,
  {{unfold bounded_term_comparison id, fapply universal_map_inj_of_components_inj,
  change ∀ i : ℕ, function.injective ((cocone_of_bounded_term_L_infty n l).map i),
  dsimp[cocone_of_bounded_term_L_infty],  intro m,
  fapply Lhom.on_bounded_term_inj (@henkin_language_canonical_map_inj L m)},},
   {intro f, induction f,
    {refine ⟨(by {fapply canonical_map, by {change ℕ, exact 0}, exact bd_var f}), by split⟩},
    {have W := germ_rep f_f, rcases W with ⟨⟨i,x⟩, Hx⟩, fapply exists.intro,
     fapply canonical_map i, fapply bd_func, exact x, rw[<-Hx], refl,},
    {rcases f_ih_t with ⟨t, Ht⟩, rcases f_ih_s with ⟨s,Hs⟩, have Wt := germ_rep t,
    have Ws := germ_rep s, rcases Wt with ⟨⟨i,x_t⟩, Hxt⟩, rcases Ws with ⟨⟨j, x_s⟩, Hxs⟩,
    let x_t' : (henkin_bounded_term_chain n (f_l + 1)).obj (i+j),
      fapply (henkin_bounded_term_chain n (f_l + 1)).mor, exact i,
      simp only [ℕ', directed_type.rel, id.def, zero_le, le_add_iff_nonneg_right],
      exact x_t,
    let x_s' : (henkin_bounded_term_chain n 0).obj (i+j),
      fapply (henkin_bounded_term_chain n 0).mor, exact j,
      simp only [ℕ', directed_type.rel, zero_le, le_add_iff_nonneg_left],
      exact x_s,
    have Hxt' : ⟦(⟨i+j,x_t'⟩ : coproduct_of_directed_diagram $ henkin_bounded_term_chain n (f_l + 1))⟧ = t,
      {rw[<-Hxt], simp[(≈), germ_relation], refine ⟨(i+j),x_t',⟨by simp,_⟩,_⟩,
       dsimp[henkin_bounded_term_chain, henkin_language_chain_maps], let k := i + j,
       simp only [id_of_self_map], apply Lhom.id_bounded_term,
       fapply exists.intro, simp only [zero_le, le_add_iff_nonneg_right]},
    have Hxs' : ⟦(⟨i+j,x_s'⟩ : coproduct_of_directed_diagram $ henkin_bounded_term_chain n 0)⟧ = s,
    {{rw[<-Hxs], simp[(≈), germ_relation], refine ⟨(i+j),x_s',⟨by simp,_⟩,_⟩,
       dsimp[henkin_bounded_term_chain, henkin_language_chain_maps], let k := i + j,
       simp only [id_of_self_map], apply Lhom.id_bounded_term,
       fapply exists.intro, simp only [zero_le, le_add_iff_nonneg_left]},},
    fapply exists.intro, fapply canonical_map, change ℕ, exact (i + j),
    fapply bd_app, exact x_t', exact x_s', rw[<-Ht, <-Hs, <-Hxt', <-Hxs'], refl},}
end

@[simp]lemma bounded_formula_comparison_bijective {L : Language} (n l) : function.bijective (@bounded_formula_comparison L n l) :=
begin
refine ⟨_,_⟩,
  {{unfold bounded_formula_comparison id, fapply universal_map_inj_of_components_inj,
  change ∀ i : ℕ, function.injective ((cocone_of_bounded_formula_L_infty n l).map i),
  dsimp[cocone_of_bounded_formula_L_infty],  intro m,
  fapply Lhom.on_bounded_formula_inj (@henkin_language_canonical_map_inj L m)},},
  {intro f, induction f,
  {refine ⟨(by {fapply canonical_map, by {change ℕ, exact 0}, exact bd_falsum}), by split⟩},
  {
    rcases (bounded_term_comparison_bijective f_n 0).right f_t₁ with ⟨t₁, H₁⟩, rcases (bounded_term_comparison_bijective f_n 0).right f_t₂ with ⟨t₂, H₂⟩,
    rcases germ_rep t₁ with ⟨⟨i,x⟩,Hx⟩, rcases germ_rep t₂ with ⟨⟨j,y⟩,Hy⟩,
    fapply exists.intro, fapply canonical_map, exact i+j, fapply bd_equal,
    exact push_to_sum_r x j, exact push_to_sum_l y i,
    simp[H₁, H₂],
    rw[<-H₁, <-H₂,<-Hx, <-Hy, <-canonical_map_quotient, same_fiber_as_push_to_r x j ,<-canonical_map_quotient, same_fiber_as_push_to_l y i],
    simpa only},
  {have x := germ_rep f_R, rcases x with ⟨⟨i,x⟩,H⟩, fapply exists.intro, have R' := bd_rel x,
   exact ⟦⟨i,R'⟩⟧, tidy},
  {rcases f_ih with ⟨t₁, H₁⟩,
   rcases (bounded_term_comparison_bijective _ 0).right f_t with ⟨t₂, H₂⟩,
   rcases germ_rep t₁ with ⟨⟨i,x⟩,Hx⟩, rcases germ_rep t₂ with ⟨⟨j,y⟩,Hy⟩,
   fapply exists.intro, fapply canonical_map, exact i+j, fapply bd_apprel,
   exact push_to_sum_r x j, exact push_to_sum_l y i,
    rw[<-H₁, <-H₂,<-Hx, <-Hy, <-canonical_map_quotient, same_fiber_as_push_to_r x j ,<-canonical_map_quotient, same_fiber_as_push_to_l y i],
    simpa only},
  {rcases f_ih_f₁ with ⟨t₁, H₁⟩, rcases f_ih_f₂ with ⟨t₂, H₂⟩,
   rcases germ_rep t₁ with ⟨⟨i,x⟩,Hx⟩, rcases germ_rep t₂ with ⟨⟨j,y⟩,Hy⟩,
   fapply exists.intro, fapply canonical_map, exact (i+j), fapply bd_imp,
   exact push_to_sum_r x j, exact push_to_sum_l y i,
    rw[<-H₁, <-H₂,<-Hx, <-Hy, <-canonical_map_quotient, same_fiber_as_push_to_r x j ,<-canonical_map_quotient, same_fiber_as_push_to_l y i],
    simpa only},
  {rcases f_ih with ⟨t₁, H₁⟩, rcases germ_rep t₁ with ⟨⟨i,x⟩,Hx⟩,
   fapply exists.intro, fapply canonical_map, exact i, fapply bd_all,
   exact x, rw[<-H₁, <-Hx], simpa only}},
end

@[simp]lemma bounded_formula'_comparison_bijective {L : Language} : function.bijective (@bounded_formula'_comparison L) :=
by apply bounded_formula_comparison_bijective

noncomputable def equiv_bounded_formula_comparison {L : Language} : equiv (colimit (@henkin_bounded_formula_chain' L)) (bounded_formula (L_infty L) 1) :=
begin fapply equiv.of_bijective, exacts [bounded_formula'_comparison, bounded_formula'_comparison_bijective] end

/- Not really a chain, since we haven't set up interpretations of theories yet -/
def henkin_theory_chain {L : Language} (T : Theory L) : Π(n : ℕ), (Theory (obj (@henkin_language_chain L) n))
| 0 := T
| (n+1) := henkin_theory_step (henkin_theory_chain n)

def is_consistent_henkin_theory_chain {L} {T : Theory L} (hT : is_consistent T) (n : ℕ) :
  is_consistent (henkin_theory_chain T n) :=
by induction n; [exact hT, exact is_consistent_henkin_theory_step n_ih]

/- Now we have to push all these theories into Theory L_∞, so that they literally become a chain
   of sets. -/

/- Given T_n from henkin_theory_chain, ι T_n is the expansion of T_n to an L_infty theory -/
def ι {L : Language} {T : Theory L} (m : ℕ) :  Theory (L_infty L) :=
(Lhom.on_sentence (@henkin_language_canonical_map L m)) '' (@henkin_theory_chain L T m)

@[simp]lemma in_iota_of_in_step {L} (i) {T} (f : sentence (@henkin_language_chain_objects L (i+1))): f ∈ (@henkin_theory_chain L T (i+1)) →  Lhom.on_bounded_formula (@henkin_language_canonical_map L (i + 1)) f ∈ @ι L T (i + 1) :=
  by {intro H, split, swap, exact f, refine ⟨H,_⟩, refl}

@[simp]lemma is_consistent_iota {L : Language} {T : Theory L} (hT : is_consistent T) (m : ℕ) : is_consistent (@ι _ T m) :=
begin
  unfold ι, intro,
  have := @is_consistent_henkin_theory_chain L T hT m,
  suffices : (henkin_theory_chain T m) ⊢' bd_falsum, by contradiction,
  apply nonempty.intro, apply reflect_prf,
  exact henkin_language_canonical_map_inj m,
  simp[on_formula, bounded_preformula.fst, Theory.fst, set.image_image, sprovable, on_sentence_fst] at *;
  exact classical.choice a
end

@[simp]lemma not_succ (i : ℕ) : ¬ i = i + 1 :=
by {have := nat.succ_ne_self i, tidy}

lemma henkin_theory_chain_inclusion_step {L} {T : Theory L} {i : ℕ} {f ∈ henkin_theory_chain T i} : (henkin_bounded_formula_chain 0 0).mor (by simp) f ∈ henkin_theory_chain T (i + 1) :=
begin
dsimp[henkin_bounded_formula_chain, henkin_theory_chain],
apply or.inl,
unfold Theory_induced, fapply exists.intro, tidy,
end

lemma henkin_theory_chain_inclusion {L} {T : Theory L} {i j : ℕ} (h_leq : i ≤ j + 1) {f ∈ henkin_theory_chain T i} : (henkin_bounded_formula_chain 0 0).mor (by exact h_leq) f ∈ henkin_theory_chain T (j + 1) :=
begin
  dsimp[henkin_bounded_formula_chain],
  by_cases i = j +1,
    subst h, simp[id_bounded_formula 0 0 f], exact H,
  induction j with j ih,
    {have : i = 0,
      {suffices : i ≤ 0, by exact nat.eq_zero_of_le_zero this,
        fapply nat.le_of_le_and_ne_succ, repeat{assumption}},
    subst this,
    apply or.inl, fapply exists.intro,
    exact f, tidy},

    have : i ≤ nat.succ j,
      by {fapply nat.le_of_le_and_ne_succ, repeat{assumption}},
    have := ih this,
    by_cases i = j+1,
       subst h, apply henkin_theory_chain_inclusion_step, assumption,
  unfold on_sentence henkin_language_chain_maps,
  simp*, apply or.inl, unfold Theory_induced,
  fapply exists.intro,
  exact on_bounded_formula (henkin_language_chain_maps L i (j+1) (by assumption)) f,
  split, apply ih, assumption, dedup,
  dsimp[on_sentence], unfold henkin_language_chain_maps, simp*,
  change  on_bounded_formula
      (henkin_language_chain_maps L (j+1) (j+2) _)
      (on_bounded_formula (henkin_language_chain_maps L j (j + 1) _)
         (on_bounded_formula (henkin_language_chain_maps L i j _) f)) =
    on_bounded_formula (henkin_language_chain_maps L (j + 1) (j + 2) _)
      (on_bounded_formula ((Lhom.id (henkin_language_chain_objects (j + 1))))
         (on_bounded_formula (henkin_language_chain_maps L j (j + 1) _)
            (on_bounded_formula (Lhom.id (henkin_language_chain_objects j))
               (on_bounded_formula (henkin_language_chain_maps L i j _) f)))),
  simp only [id_bounded_formula 0 0, not_false_iff, nat.le_of_le_and_ne_succ, fol.Lhom.on_bounded_formula]
end

@[simp]lemma iota_inclusion_of_le {L} {T : Theory L} : Π{i : ℕ} {j : ℕ} (h : i ≤ j), (@ι _ T i) ⊆ (@ι _ T j)
| i 0 h :=  by rw[(nat.eq_zero_of_le_zero h)]
| i (j+1) h := by {by_cases i = j+1, rw[h],
                   have := (cocone_of_bounded_formula_L_infty 0 0).h_compat,
                   have this' := @this i (j+1) (by simp*),
                   dsimp[cocone_of_bounded_formula_L_infty] at this',
                   dsimp[ι, on_sentence], show Language, exact L,
                   intros ψ hψ, have hψ_w := classical.psigma_of_exists hψ,
                   cases hψ_w with x Hx,
                   refine ⟨(@henkin_bounded_formula_chain L 0 0).mor (by assumption) x,_⟩,
                   split, {simp[henkin_theory_chain_inclusion, Hx]},
                   simp, change (function.comp (on_bounded_formula
                   (henkin_language_canonical_map (j + 1)))
                   ((henkin_bounded_formula_chain 0 0).mor _)) x = ψ,
                   rw[<-this'], exact Hx.right
                   }

/- T_infty is the henkinization of T; we define it to be the union ⋃ (n : ℕ), ι(T n). -/
@[reducible]def T_infty {L : Language} (T : Theory L) : Theory (L_infty L) := set.Union (@ι L T)

@[reducible]def henkin_language {L} {T : Theory L} {hT : is_consistent T} : Language := L_infty L

local infix ` →ᴸ `:10 := Lhom -- \^L

/- I dislike this proof, but I don't know how apply canonical_map_language otherwise... -/
def henkin_language_over {L} {T : Theory L} {hT : is_consistent T} : L →ᴸ (@henkin_language L T hT) :=
by {change (henkin_language_chain.obj (0 : ℕ)) →ᴸ colimit_language henkin_language_chain, apply canonical_map_language}

lemma henkin_language_over_injective {L} {T : Theory L} {hT : is_consistent T} : Lhom.is_injective (@henkin_language_over L T hT) :=
begin
  split, all_goals{intro n, unfold henkin_language_over canonical_map_language, simp,
  rw[<-canonical_map], fapply canonical_map_inj_of_transition_maps_inj, intros i j H,
  dsimp[diagram_functions, diagram_relations, henkin_language_chain],
  simp only [henkin_language_chain_maps_inj, Lhom.is_injective.on_function, Lhom.is_injective.on_relation]}
end

def complete_henkin_Theory_over {L : Language} (T : Theory L) (hT : is_consistent T) : Type u := Σ' T' : Theory_over T hT, has_enough_constants T'.val ∧ is_complete T'.val

@[reducible]def henkinization {L : Language} {T : Theory L} (hT : is_consistent T) : Theory (@henkin_language L T hT) := T_infty T

/-- Given an f : bounded_formula L_infty, return a Henkin witness for f, along with all the
    data and conditions needed to obtain this witness --/
noncomputable def wit_infty {L} {T : Theory L} {hT : is_consistent T} (f : bounded_formula (@henkin_language L T hT) 1) : Σ c : (@henkin_language L T hT).constants, Σ (f' : Σ' (x : colimit (@henkin_bounded_formula_chain' L)), bounded_formula'_comparison x = f), Σ' (f'' : coproduct_of_directed_diagram (@henkin_bounded_formula_chain' L)), ⟦f''⟧ = f'.fst ∧ c = (henkin_language_canonical_map (f''.fst + 1)).on_function  (wit' f''.snd) :=
begin
  have f_lift1 := classical.psigma_of_exists ((bounded_formula'_comparison_bijective).right f),
  have f_lift2 := germ_rep (f_lift1.fst),
  refine ⟨(henkin_language_canonical_map (f_lift2.fst.fst + 1)).on_function (wit' (f_lift2.fst.snd)), f_lift1,(f_lift2.fst), f_lift2.snd,rfl⟩,
end

@[simp]lemma henkinization_is_henkin {L : Language} {T : Theory L} (hT : is_consistent T) : has_enough_constants (henkinization hT) :=
begin
  apply has_enough_constants.intro,
  unfold henkinization T_infty, intro f, have big_sigma := wit_infty f, rcases big_sigma with ⟨c, Hc⟩, refine ⟨c,_⟩,
  rcases Hc with ⟨⟨f', Hf'⟩,⟨i, f''⟩, H⟩,
  fapply nonempty.intro, fapply axm,
  simp only [*, fol.subst_formula, fol.bounded_preterm.fst, set.mem_Union, set.mem_image, fol.subst0_bounded_formula_fst, fol.bounded_preformula.fst],
  refine ⟨_,⟨(i+1),_⟩,_⟩,
  {fapply Lhom.on_bounded_formula, exact (@henkin_language_chain L).obj (i+1),
   fapply henkin_language_canonical_map, fapply wit_property, fapply Lhom.on_bounded_formula,
   exact (@henkin_language_chain L).obj i, exact henkin_language_inclusion,
   exact f'', exact (wit' f'')},
  {fapply in_iota_of_in_step, fapply or.inr, tidy},
  {let c_infty := (bd_const ((henkin_language_canonical_map (i + 1)).on_function (wit' f''))),
  have this1 : bounded_preformula.fst (∃' f) ⟹
      (bounded_preformula.fst f)[bounded_preterm.fst
          (bd_const ((henkin_language_canonical_map (i + 1)).on_function (wit' f''))) //
        0] = bounded_preformula.fst ((∃' f) ⟹ f[c_infty/0]), by simp, rw[this1],
  suffices : (Lhom.on_bounded_formula (henkin_language_canonical_map (i + 1))
         (wit_property (Lhom.on_bounded_formula henkin_language_inclusion f'') (wit' f''))) = (∃' f ⟹ f[c_infty /0]), by rw[this],
  unfold wit_property at *, dsimp[c_infty], rw[<-canonical_map_quotient] at H, dsimp at H,
  rw[<-Hf',<-H.left],
  unfold bounded_formula'_comparison bounded_formula_comparison id,
  rw[(@universal_map_property ℕ' (henkin_bounded_formula_chain') (cocone_of_bounded_formula'_L_infty) i f'')],
  dsimp[cocone_of_bounded_formula'_L_infty],
  have : henkin_language_canonical_map i = henkin_language_canonical_map (i+1) ∘ henkin_language_inclusion,
    {have := cocone_of_L_infty.h_compat, have a := @this i (i+1) (by simp),
     dsimp[cocone_of_L_infty, cocone_of_colimit_language, henkin_language_chain] at a,
     unfold henkin_language_canonical_map, simp only [*, henkin_language_inclusion_chain_map],
     exact a},
  rw[this,Lhom.comp_on_bounded_formula],
  have : (function.comp (Lhom.on_bounded_formula (henkin_language_canonical_map (i + 1)))
           (Lhom.on_bounded_formula henkin_language_inclusion) f'') = Lhom.on_bounded_formula (henkin_language_canonical_map (i+1)) (Lhom.on_bounded_formula henkin_language_inclusion f''),
       by refl,
  rw[this],
  have : (Lhom.on_bounded_formula (henkin_language_canonical_map (i + 1))
           (Lhom.on_bounded_formula henkin_language_inclusion f''))[bd_const
          ((henkin_language_canonical_map (i + 1)).on_function (wit' f'')) /0] =
          (Lhom.on_bounded_formula (henkin_language_canonical_map (i + 1))
           ((Lhom.on_bounded_formula henkin_language_inclusion f'')[bd_const
           (wit' f'') /0])),
  by tidy, rw[this],
  have : ∃' Lhom.on_bounded_formula (henkin_language_canonical_map (i + 1))
          (Lhom.on_bounded_formula henkin_language_inclusion f'')
          = Lhom.on_bounded_formula (henkin_language_canonical_map (i+1)) (∃' (Lhom.on_bounded_formula henkin_language_inclusion f'')),
  by tidy, rw[this]}
end

noncomputable def directed_union_finset_lift {α β : Type*} (ι : α → set β) (Γ' : finset (set.Union ι)) (x ∈ Γ') : Σ' a : α, (ι a) x :=
begin
cases x with x H', have := classical.psigma_of_exists H',
rcases this with ⟨S,a⟩, simp[*,-a] at a, cases a with a1 a2,
have := classical.psigma_of_exists a1, cases this with a Ha,
rw[← Ha] at a2, exact ⟨a, a2⟩
end

/- For every n, T_n is a theory over T in Theory L_infty -/
def henkin_Theory_over {L} (T : Theory L) (hT : is_consistent T) (n : ℕ) : Theory_over (@ι _ T 0) (@is_consistent_iota L T hT 0) :=
by { refine ⟨@ι _ T n, _⟩, split, apply iota_inclusion_of_le, simp, apply is_consistent_iota hT}

def henkin_theory_schain {L} (T : Theory L) (hT : is_consistent T): set (Theory_over (@ι _ T 0) (@is_consistent_iota L T hT 0))
:= {T' | ∃ k : ℕ, (@ι _ T k) = T'.val}

/- (T ∪ set.sUnion (subtype.val '' Ts)) actually is (henkinization hT) -/
lemma iota_union_rw {L} (T : Theory L) (hT : is_consistent T) : (@ι _ T 0) ∪ ⋃₀(subtype.val '' henkin_theory_schain T hT) = henkinization hT :=
begin
  ext, split; intros; auto_cases,
    {tidy},
    {tidy},
    {right, cases a_h with H₁ H₂, use a_w, refine ⟨_,‹_›⟩,
      { unfold henkin_theory_schain, rw[set.mem_range] at H₁,
        cases H₁ with n Hn, rw[set.mem_image], refine ⟨_,_⟩,
        use a_w, tidy, apply is_consistent_iota; from ‹_› }}, recover
end

/- henkin_theory_chain satisfies the chain condition -/
lemma chain_henkin_theory_chain {L} (T : Theory L) (hT : is_consistent T) : zorn.chain Theory_over_subset (henkin_theory_schain T hT) :=
begin
  tidy, rename H_1_w i, rename H_w j,
  by_cases i ≤ j, apply or.inr, apply iota_inclusion_of_le, exact h,
  apply or.inl, suffices : j ≤ i, by {apply iota_inclusion_of_le, exact this},
  revert h, simp only [not_le], apply nat.le_of_lt
end

lemma is_consistent_henkinization {L : Language} {T : Theory L} (hT : is_consistent T) :
is_consistent (henkinization hT) :=
begin
  have := @consis_limit _ _ _ (henkin_theory_schain T hT), rw[iota_union_rw] at this,
  exact this (chain_henkin_theory_chain T hT)
end

-- @[simp]lemma is_consistent_henkinization {L : Language} {T : Theory L} (hT : is_consistent T) : is_consistent (henkinization hT) :=
-- begin
  -- intro P, have := proof_compactness P,
  -- have : ∃ k : ℕ, @ι L T k ⊢' bd_falsum,
  -- {sorry}, -- again, this depends on picking a representative of a germ-eq class
  --          -- on the induced colimit of formulas
  --          -- remark(Floris): we need a lemma that if a directed union of theories proves f, then an element of it proves f.
  -- cases this with k P', unfold ι at P',
  -- apply is_consistent_henkin_theory_chain hT k,
  -- apply nonempty.map (Lhom.reflect_prf (henkin_language_canonical_map_inj k)),
  -- simp only [on_formula, bounded_preformula.fst, Theory.fst, set.image_image, sprovable,
  --   on_sentence_fst] at P' ⊢, exact P'
-- end

@[reducible]noncomputable def completion_of_henkinization_core {L} {T : Theory L} (hT : is_consistent T) : Σ' (T' : Theory_over (henkinization hT) _), is_complete (T'.val) := completion_of_consis _ (henkinization hT) (is_consistent_henkinization hT)

/- the completed theory-/
@[reducible]def completion_of_henkinization {L} {T : Theory L} (hT : is_consistent T) := (completion_of_henkinization_core (by assumption)).fst.val

/- the completed theory contains the original theory -/
@[simp]def completion_of_henkinization_contains {L} {T : Theory L} (hT : is_consistent T) := (completion_of_henkinization_core (by assumption)).fst.property.left

/- the completed theory is consistent -/
@[simp]def completion_of_henkinization_consistent {L} {T : Theory L} (hT : is_consistent T) := (completion_of_henkinization_core (by assumption)).fst.property.right

/- the completed theory is complete -/
@[reducible]def completion_of_henkinization_complete {L} {T : Theory L} (hT : is_consistent T) := (completion_of_henkinization_core (by assumption)).snd

/- the completed theory is henkin -/
@[simp]lemma completion_of_henkinization_is_henkin {L} {T : Theory L} (hT : is_consistent T) : has_enough_constants (completion_of_henkinization hT) :=
begin
fapply has_enough_constants.intro,
  cases (@henkinization_is_henkin L T hT) with C H,
  intro f, refine ⟨C f,_⟩, fapply weakening', exact (Theory.fst $ (henkinization hT)), fapply set.image_subset, simp, exact H f
end

/- The term model of the complete henkinization of T satisfies T -/
@[simp]lemma reduct_of_complete_henkinization_models_T {L} {T : Theory L} (hT : is_consistent T) : Lhom.reduct (@henkin_language_canonical_map L 0) (term_model (completion_of_henkinization hT)) ⊨ T :=
begin
  fapply Lhom.reduct_all_ssatisfied,
  {simp only [henkin_language_canonical_map_inj]}, intros f hf,
  apply (term_model_ssatisfied (completion_of_henkinization_complete hT) (completion_of_henkinization_is_henkin hT)), fapply completion_of_henkinization_contains hT,
  unfold henkinization T_infty, simp, refine ⟨0, _⟩, unfold ι, tidy
end

/- Given ψ ∈ T, the term model of the complete henkinization of T satisfies ψ -/
@[simp]lemma reduct_of_complete_henkinization_satisfies {L} {T : Theory L} (hT : is_consistent T) (ψ : sentence L) (hψ : ψ ∈ T) : Lhom.reduct (@henkin_language_canonical_map L 0) (term_model (completion_of_henkinization hT)) ⊨ ψ :=
  reduct_of_complete_henkinization_models_T _ hψ


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov
-/
import topology.metric_space.emetric_space

/-!
# `Gδ` sets

In this file we define `Gδ` sets and prove their basic properties.

## Main definitions

* `is_Gδ`: a set `s` is a `Gδ` set if it can be represented as an intersection
  of countably many open sets;

* `residual`: the filter of residual sets. A set `s` is called *residual* if it includes a dense
  `Gδ` set. In a Baire space (e.g., in a complete (e)metric space), residual sets form a filter.

  For technical reasons, we define `residual` in any topological space but the definition agrees
  with the description above only in Baire spaces.

## Main results

We prove that finite or countable intersections of Gδ sets is a Gδ set. We also prove that the
continuity set of a function from a topological space to an (e)metric space is a Gδ set.

## Tags

Gδ set, residual set
-/

noncomputable theory
open_locale classical topological_space filter

open filter encodable set

variables {α : Type*} {β : Type*} {γ : Type*} {ι : Type*}

section is_Gδ
variable [topological_space α]

/-- A Gδ set is a countable intersection of open sets. -/
def is_Gδ (s : set α) : Prop :=
  ∃T : set (set α), (∀t ∈ T, is_open t) ∧ countable T ∧ s = (⋂₀ T)

/-- An open set is a Gδ set. -/
lemma is_open.is_Gδ {s : set α} (h : is_open s) : is_Gδ s :=
⟨{s}, by simp [h], countable_singleton _, (set.sInter_singleton _).symm⟩

lemma is_Gδ_univ : is_Gδ (univ : set α) := is_open_univ.is_Gδ

lemma is_Gδ_bInter_of_open {I : set ι} (hI : countable I) {f : ι → set α}
  (hf : ∀i ∈ I, is_open (f i)) : is_Gδ (⋂i∈I, f i) :=
⟨f '' I, by rwa ball_image_iff, hI.image _, by rw sInter_image⟩

lemma is_Gδ_Inter_of_open [encodable ι] {f : ι → set α}
  (hf : ∀i, is_open (f i)) : is_Gδ (⋂i, f i) :=
⟨range f, by rwa forall_range_iff, countable_range _, by rw sInter_range⟩

/-- A countable intersection of Gδ sets is a Gδ set. -/
lemma is_Gδ_sInter {S : set (set α)} (h : ∀s∈S, is_Gδ s) (hS : countable S) : is_Gδ (⋂₀ S) :=
begin
  choose T hT using h,
  refine ⟨_, _, _, (sInter_bUnion (λ s hs, (hT s hs).2.2)).symm⟩,
  { simp only [mem_Union],
    rintros t ⟨s, hs, tTs⟩,
    exact (hT s hs).1 t tTs },
  { exact hS.bUnion (λs hs, (hT s hs).2.1) },
end

lemma is_Gδ_Inter [encodable ι]  {s : ι → set α} (hs : ∀ i, is_Gδ (s i)) : is_Gδ (⋂ i, s i) :=
is_Gδ_sInter (forall_range_iff.2 hs) $ countable_range s

lemma is_Gδ_bInter {s : set ι} (hs : countable s) {t : Π i ∈ s, set α}
  (ht : ∀ i ∈ s, is_Gδ (t i ‹_›)) : is_Gδ (⋂ i ∈ s, t i ‹_›) :=
begin
  rw [bInter_eq_Inter],
  haveI := hs.to_encodable,
  exact is_Gδ_Inter (λ x, ht x x.2)
end

lemma is_Gδ.inter {s t : set α} (hs : is_Gδ s) (ht : is_Gδ t) : is_Gδ (s ∩ t) :=
by { rw inter_eq_Inter, exact is_Gδ_Inter (bool.forall_bool.2 ⟨ht, hs⟩) }

/-- The union of two Gδ sets is a Gδ set. -/
lemma is_Gδ.union {s t : set α} (hs : is_Gδ s) (ht : is_Gδ t) : is_Gδ (s ∪ t) :=
begin
  rcases hs with ⟨S, Sopen, Scount, rfl⟩,
  rcases ht with ⟨T, Topen, Tcount, rfl⟩,
  rw [sInter_union_sInter],
  apply is_Gδ_bInter_of_open (Scount.prod Tcount),
  rintros ⟨a, b⟩ hab,
  exact is_open_union (Sopen a hab.1) (Topen b hab.2)
end

end is_Gδ

section continuous_at

open topological_space
open_locale uniformity

variables [topological_space α]

lemma is_Gδ_set_of_continuous_at_of_countably_generated_uniformity
  [uniform_space β] (hU : is_countably_generated (𝓤 β)) (f : α → β) :
  is_Gδ {x | continuous_at f x} :=
begin
  rcases hU.exists_antimono_subbasis uniformity_has_basis_open_symmetric with ⟨U, hUo, hU⟩,
  simp only [uniform.continuous_at_iff_prod, nhds_prod_eq],
  simp only [(nhds_basis_opens _).prod_self.tendsto_iff hU.to_has_basis, forall_prop_of_true,
    set_of_forall, id],
  refine is_Gδ_Inter (λ k, is_open.is_Gδ $ is_open_iff_mem_nhds.2 $ λ x, _),
  rintros ⟨s, ⟨hsx, hso⟩, hsU⟩,
  filter_upwards [mem_nhds_sets hso hsx],
  intros y hy,
  exact ⟨s, ⟨hy, hso⟩, hsU⟩
end

/-- The set of points where a function is continuous is a Gδ set. -/
lemma is_Gδ_set_of_continuous_at [emetric_space β] (f : α → β) :
  is_Gδ {x | continuous_at f x} :=
is_Gδ_set_of_continuous_at_of_countably_generated_uniformity
  emetric.uniformity_has_countable_basis _

end continuous_at

/-- A set `s` is called *residual* if it includes a dense `Gδ` set. If `α` is a Baire space
(e.g., a complete metric space), then residual sets form a filter, see `mem_residual`.

For technical reasons we define the filter `residual` in any topological space but in a non-Baire
space it is not useful because it may contain some non-residual sets. -/
def residual (α : Type*) [topological_space α] : filter α :=
⨅ t (ht : is_Gδ t) (ht' : dense t), 𝓟 t