import abelian_power_quandle

universes u v

section abelianization_pq

inductive pre_abelianization_pq (Q : Type u) [power_quandle Q] : Type u
| incl (x : Q) : pre_abelianization_pq
| add (x y : pre_abelianization_pq) : pre_abelianization_pq
| neg (x : pre_abelianization_pq) : pre_abelianization_pq
| zero : pre_abelianization_pq
| pow (x : pre_abelianization_pq) (n : ℤ) : pre_abelianization_pq

open pre_abelianization_pq

inductive pre_abelianization_pq_rel' (Q : Type u) [power_quandle Q] : pre_abelianization_pq Q → pre_abelianization_pq Q → Type u
| refl {x : pre_abelianization_pq Q} : pre_abelianization_pq_rel' x x
| symm {x y : pre_abelianization_pq Q} (hxy : pre_abelianization_pq_rel' x y) : pre_abelianization_pq_rel' y x
| trans {x y z : pre_abelianization_pq Q} (hxy : pre_abelianization_pq_rel' x y) (hyz : pre_abelianization_pq_rel' y z) : pre_abelianization_pq_rel' x z
| congr_add {x1 x2 y1 y2 : pre_abelianization_pq Q} (hx : pre_abelianization_pq_rel' x1 x2) (hy : pre_abelianization_pq_rel' y1 y2) : pre_abelianization_pq_rel' (add x1 y1) (add x2 y2)
| congr_neg {x1 x2 : pre_abelianization_pq Q} (hx : pre_abelianization_pq_rel' x1 x2) : pre_abelianization_pq_rel' (neg x1) (neg x2)
| congr_pow {x1 x2 : pre_abelianization_pq Q} {n : ℤ} (hx : pre_abelianization_pq_rel' x1 x2) : pre_abelianization_pq_rel' (pow x1 n) (pow x2 n)
| add_assoc (x y z : pre_abelianization_pq Q) : pre_abelianization_pq_rel' (add (add x y) z) (add x (add y z))
| add_comm (x y : pre_abelianization_pq Q) : pre_abelianization_pq_rel' (add x y) (add y x)
| zero_right (x : pre_abelianization_pq Q) :
pre_abelianization_pq_rel' (add x zero) (x)
| neg_add_right (x : pre_abelianization_pq Q) :
pre_abelianization_pq_rel' (add x (neg x)) (zero)
| pow_one (x : pre_abelianization_pq Q) : pre_abelianization_pq_rel' (pow x (1 : ℤ)) (x)
| pow_exp_zero (x : pre_abelianization_pq Q) : pre_abelianization_pq_rel' (pow x (0 : ℤ)) (incl 1)
| pow_comp (x : pre_abelianization_pq Q) (n m : ℤ) : pre_abelianization_pq_rel' (pow (pow x n) m) (pow x (n * m))
| pow_add (x y : pre_abelianization_pq Q) (n : ℤ) : pre_abelianization_pq_rel' (add (pow x n) (pow y n)) (pow (add x y) n)
| pow_neg (x : pre_abelianization_pq Q) (n : ℤ) : pre_abelianization_pq_rel' (neg (pow x n)) (pow (neg x) n)
| pow_zero (n : ℤ) : pre_abelianization_pq_rel' (pow zero n) (zero)
| rhd_incl (x y : Q) : pre_abelianization_pq_rel' (incl (x ▷ y)) (incl y)
| pow_incl (x : Q) (n : ℤ) : pre_abelianization_pq_rel' (incl (x ^ n)) (pow (incl x) n)

inductive pre_abelianization_pq_rel (Q : Type u) [power_quandle Q] : pre_abelianization_pq Q → pre_abelianization_pq Q → Prop
| rel {x y : pre_abelianization_pq Q} (hxy : pre_abelianization_pq_rel' Q x y) : pre_abelianization_pq_rel x y

variables {Q : Type u} [power_quandle Q]

lemma pre_abelianization_pq_rel'.rel {a b : pre_abelianization_pq Q} : pre_abelianization_pq_rel' Q a b → pre_abelianization_pq_rel Q a b := pre_abelianization_pq_rel.rel

@[refl]
lemma pre_abelianization_pq_rel.refl {a : pre_abelianization_pq Q} : pre_abelianization_pq_rel Q a a :=
pre_abelianization_pq_rel'.rel pre_abelianization_pq_rel'.refl

@[symm]
lemma pre_abelianization_pq_rel.symm {a b : pre_abelianization_pq Q} : pre_abelianization_pq_rel Q a b → pre_abelianization_pq_rel Q b a
| ⟨r⟩ := r.symm.rel

@[trans]
lemma pre_abelianization_pq_rel.trans {a b c : pre_abelianization_pq Q} :
pre_abelianization_pq_rel Q a b → pre_abelianization_pq_rel Q b c → pre_abelianization_pq_rel Q a c
| ⟨rab⟩ ⟨rbc⟩ := (rab.trans rbc).rel

instance pre_abelianization_pq.setoid (Q : Type*) [power_quandle Q] : setoid (pre_abelianization_pq Q) :=
{
    r := pre_abelianization_pq_rel Q,
    iseqv := begin
        split, apply pre_abelianization_pq_rel.refl,
        split, apply pre_abelianization_pq_rel.symm,
        apply pre_abelianization_pq_rel.trans,
    end
}

def abelianization_pq (Q : Type u) [power_quandle Q] : Type u := quotient (pre_abelianization_pq.setoid Q)

instance abelianization_pq_has_add : has_add (abelianization_pq Q) := ⟨λ a b, quotient.lift_on₂ a b (λ a b, ⟦add a b⟧) (begin
  intros a b c d hac hbd,
  cases hac with hac,
  cases hbd with hbc,
  apply quotient.sound,
  fconstructor,
  apply pre_abelianization_pq_rel'.congr_add,
  assumption,
  assumption,
end)⟩

instance abelianization_pq_has_neg : has_neg (abelianization_pq Q) := ⟨λ a, quotient.lift_on a (λ a, ⟦neg a⟧) (begin
  intros a b hab,
  cases hab with hab,
  apply quotient.sound,
  fconstructor,
  apply pre_abelianization_pq_rel'.congr_neg,
  assumption,
end)⟩

instance abelianization_pq_has_zero : has_zero (abelianization_pq Q) := ⟨⟦zero⟧⟩

instance abelianizaiton_pq_has_rhd : has_rhd (abelianization_pq Q) :=
⟨λ a b, b⟩

instance abelianization_pq_has_pow : has_pow (abelianization_pq Q) ℤ :=
⟨λ a n, quotient.lift_on a (λ a, ⟦pow a n⟧) (begin
  intros a b hab,
  cases hab with hab,
  apply quotient.sound,
  fconstructor,
  apply pre_abelianization_pq_rel'.congr_pow,
  assumption,
end)⟩

instance abelianization_pq_has_one : has_one (abelianization_pq Q) := ⟨⟦incl 1⟧⟩

lemma abelianization_pq_add_def (x y : pre_abelianization_pq Q) : (⟦x⟧ + ⟦y⟧ : abelianization_pq Q) = ⟦add x y⟧ := rfl

lemma abelianization_pq_neg_def (x : pre_abelianization_pq Q) : (-⟦x⟧ : abelianization_pq Q) = ⟦neg x⟧ := rfl

lemma abelianization_pq_zero_def : (0 : abelianization_pq Q) = ⟦zero⟧ := rfl

lemma abelianization_pq_rhd_def (x y : abelianization_pq Q) : x ▷ y = y := rfl

lemma abelianization_pq_pow_def (x : pre_abelianization_pq Q) (n : ℤ) : (⟦x⟧ ^ n : abelianization_pq Q) = ⟦pow x n⟧ := rfl

lemma abelianization_pq_one_def : (1 : abelianization_pq Q) = ⟦incl 1⟧ := rfl

lemma quot_mk_helper_abelianization (x : pre_abelianization_pq Q) : quot.mk setoid.r x = ⟦x⟧ := rfl

def apq_of : Q → abelianization_pq Q := λ q, ⟦incl q⟧

lemma apq_of_def (q : Q) : apq_of (q) = ⟦incl q⟧ := rfl

lemma apq_of_rhd (a b : Q) : apq_of (a ▷ b) = (apq_of a) ▷ (apq_of b) :=
begin
  simp only [apq_of_def],
  apply quotient.sound,
  fconstructor,
  exact pre_abelianization_pq_rel'.rhd_incl a b,
end

lemma apq_of_pow (a : Q) (n : ℤ) : apq_of (a ^ n) = (apq_of a) ^ n :=
begin
  simp only [apq_of_def],
  apply quotient.sound,
  fconstructor,
  exact pre_abelianization_pq_rel'.pow_incl a n,
end

instance abelianization_pq_is_pq : power_quandle (abelianization_pq Q) := {
  rhd_dist := begin
    intros,
    simp only [abelianization_pq_rhd_def],
  end,
  rhd_idem := begin
    intros,
    simp only [abelianization_pq_rhd_def],
  end,
  pow_one := begin
    intro a,
    induction a,
    {
      simp only [quot_mk_helper_abelianization],
      simp only [abelianization_pq_pow_def],
      apply quotient.sound,
      fconstructor,
      exact pre_abelianization_pq_rel'.pow_one a,
    },
    {refl,},
  end,
  pow_zero := begin
    intro a,
    induction a,
    {
      simp only [quot_mk_helper_abelianization],
      simp only [abelianization_pq_pow_def],
      apply quotient.sound,
      fconstructor,
      exact pre_abelianization_pq_rel'.pow_exp_zero a,
    },
    {refl,},
  end,
  pow_comp := begin
    intros a n m,
    induction a,
    {
      simp only [quot_mk_helper_abelianization],
      simp only [abelianization_pq_pow_def],
      apply quotient.sound,
      fconstructor,
      exact pre_abelianization_pq_rel'.pow_comp a n m,
    },
    {refl,},
  end,
  rhd_one := begin
    intros,
    simp only [abelianization_pq_rhd_def],
  end,
  one_rhd := begin
    intros,
    simp only [abelianization_pq_rhd_def],
  end,
  pow_rhd := begin
    intros,
    simp only [abelianization_pq_rhd_def],
  end,
  rhd_pow_add := begin
    intros,
    simp only [abelianization_pq_rhd_def],
  end }

instance abelianization_pq_is_apq : abelian_power_quandle (abelianization_pq Q) := {
  apq_unit_is_morphism := begin
    split,
    {
      intros a b,
      simp only [abelianization_pq_rhd_def],
    },
    {
      intros a n,
      symmetry,
      apply quotient.sound,
      fconstructor,
      exact pre_abelianization_pq_rel'.pow_zero n,
    }
  end,
  apq_inverse_is_morphism := begin
    split,
    {
      intros a b,
      simp only [abelianization_pq_rhd_def],
    },
    {
      intros a n,
      simp only,
      induction a,
      {
        rw quot_mk_helper_abelianization,
        apply quotient.sound,
        fconstructor,
        exact pre_abelianization_pq_rel'.pow_neg a n,
      },
      {refl,},
    },
  end,
  apq_addition_is_morphism := begin
    split,
    {
      intros a b,
      cases a with a1 a2,
      cases b with b1 b2,
      simp only [rhd_def_prod],
      simp only [abelianization_pq_rhd_def],
    },
    {
      intros a n,
      cases a with a1 a2,
      simp only [pow_def_prod],
      induction a1,
      induction a2,
      {
        simp only [quot_mk_helper_abelianization],
        apply quotient.sound,
        fconstructor,
        exact pre_abelianization_pq_rel'.pow_add a1 a2 n,
      },
      {refl,},
      {refl,},
    },
  end,
  apq_addition_assoc := begin
    intros a b c,
    induction a,
    induction b,
    induction c,
    {
      simp only [quot_mk_helper_abelianization],
      symmetry,
      apply quotient.sound,
      fconstructor,
      exact pre_abelianization_pq_rel'.add_assoc a b c,
    },
    {refl,},
    {refl,},
    {refl,},
  end,
  apq_addition_comm := begin
    intros a b,
    induction a,
    induction b,
    {
      simp only [quot_mk_helper_abelianization],
      apply quotient.sound,
      fconstructor,
      exact pre_abelianization_pq_rel'.add_comm a b,
    },
    {refl,},
    {refl,},
  end,
  apq_addition_zero_right := begin
    intros a,
    induction a,
    {
      simp only [quot_mk_helper_abelianization],
      apply quotient.sound,
      fconstructor,
      exact pre_abelianization_pq_rel'.zero_right a,
    },
    {refl,},
  end,
  apq_addition_zero_left := begin
    intros a,
    induction a,
    {
      simp only [quot_mk_helper_abelianization],
      apply quotient.sound,
      fconstructor,
      refine pre_abelianization_pq_rel'.trans _ _,
      exact a.add zero,
      apply pre_abelianization_pq_rel'.add_comm,
      exact pre_abelianization_pq_rel'.zero_right a,
    },
    {refl,},
  end,
  apq_inverse_addition_right := begin
    intros a,
    induction a,
    {
      simp only [quot_mk_helper_abelianization],
      apply quotient.sound,
      fconstructor,
      exact pre_abelianization_pq_rel'.neg_add_right a,
    },
    {refl,},
  end,
  apq_inverse_addition_left := begin
    intros a,
    induction a,
    {
      simp only [quot_mk_helper_abelianization],
      apply quotient.sound,
      fconstructor,
      refine pre_abelianization_pq_rel'.trans _ _,
      exact add (a) (neg a),
      exact pre_abelianization_pq_rel'.add_comm (neg a) a,
      exact pre_abelianization_pq_rel'.neg_add_right a,
    },
    {refl,},
  end }

lemma apq_of_is_pq_morphism : is_pq_morphism (apq_of : Q → abelianization_pq Q) :=
begin
  split,
  exact apq_of_rhd,
  exact apq_of_pow,
end

end abelianization_pq

section abelianization_pq_functor

variables {Q1 : Type u} [power_quandle Q1]
variables {Q2 : Type v} [power_quandle Q2]

open pre_abelianization_pq

def abelianization_pq_functor_pre (f : Q1 → Q2) (hf : is_pq_morphism f) : pre_abelianization_pq Q1 → pre_abelianization_pq Q2
| (incl x) := incl (f x)
| (add x y) := add (abelianization_pq_functor_pre x) (abelianization_pq_functor_pre y)
| (neg x)  := neg (abelianization_pq_functor_pre x)
| zero := zero
| (pow x n) := pow (abelianization_pq_functor_pre x) n

def abelianization_pq_functor (f : Q1 → Q2) (hf : is_pq_morphism f) : abelianization_pq Q1 → abelianization_pq Q2 := quotient.lift (λ x, ⟦abelianization_pq_functor_pre f hf x⟧) (begin
  intros a b hab,
  simp only,
  induction hab,
  induction hab_hxy,
  {
    refl,
  },
  {
    symmetry,
    assumption,
  },
  {
    transitivity,
    assumption,
    assumption,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_add_def],
    congr,
    assumption,
    assumption,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_neg_def],
    congr,
    assumption,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_pow_def],
    congr,
    assumption,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_add_def],
    rw abelian_power_quandle.apq_addition_assoc,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_add_def],
    rw abelian_power_quandle.apq_addition_comm,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_add_def, ←abelianization_pq_zero_def],
    rw abelian_power_quandle.apq_addition_zero_right,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_add_def, ←abelianization_pq_zero_def, ←abelianization_pq_neg_def],
    rw abelian_power_quandle.apq_inverse_addition_right,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_pow_def],
    rw power_quandle.pow_one,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_pow_def],
    rw one_preserved_by_morphism f hf,
    rw ←abelianization_pq_one_def,
    rw power_quandle.pow_zero,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_pow_def],
    rw power_quandle.pow_comp,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_pow_def, ←abelianization_pq_add_def],
    rw pow_dist_add,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_pow_def, ←abelianization_pq_neg_def],
    rw apq_neg_pow,

  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_pow_def, ←abelianization_pq_zero_def],
    rw apq_zero_pow,
  },
  {
    simp only [abelianization_pq_functor_pre, ←apq_of_def],
    rw hf.1,
    rw apq_of_rhd,
    rw abelianization_pq_rhd_def,
  },
  {
    simp only [abelianization_pq_functor_pre, ←abelianization_pq_pow_def, ←apq_of_def],
    rw hf.2,
    rw apq_of_pow,
  },
end)

theorem abelianization_pq_functor_is_apq_morphism (f : Q1 → Q2) (hf : is_pq_morphism f) : is_apq_morphism (abelianization_pq_functor f hf) :=
begin
  split,
  {
    intros a b,
    induction a,
    induction b,
    refl,
    refl,
    refl,
  },
  {
    intros a n,
    induction a,
    refl,
    refl,
  },
end

end abelianization_pq_functor

section abelianization_pq_adjoint

variables {Q : Type u} [power_quandle Q]
variables {A : Type v} [abelian_power_quandle A]

open pre_abelianization_pq

def apq_adjoint_lift_pre (f : Q → A) (hf : is_pq_morphism f) : pre_abelianization_pq Q → A
| (incl x) := f x
| (add x y) := (apq_adjoint_lift_pre x) + (apq_adjoint_lift_pre y)
| (neg x) := -(apq_adjoint_lift_pre x)
| (zero) := 0
| (pow x n) := (apq_adjoint_lift_pre x) ^ n

def apq_adjoint_lift (f : Q → A) (hf : is_pq_morphism f) : abelianization_pq Q → A := quotient.lift (apq_adjoint_lift_pre f hf) (begin
  intros a b hab,
  induction hab,
  induction hab_hxy,
  {
    refl,
  },
  {
    symmetry,
    assumption,
  },
  {
    transitivity,
    assumption,
    assumption,
  },
  {
    simp only [apq_adjoint_lift_pre],
    congr,
    assumption,
    assumption,
  },
  {
    simp only [apq_adjoint_lift_pre],
    congr,
    assumption,
  },
  {
    simp only [apq_adjoint_lift_pre],
    congr,
    assumption,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw abelian_power_quandle.apq_addition_assoc,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw abelian_power_quandle.apq_addition_comm,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw abelian_power_quandle.apq_addition_zero_right,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw abelian_power_quandle.apq_inverse_addition_right,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw power_quandle.pow_one,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw power_quandle.pow_zero,
    rw one_preserved_by_morphism f hf,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw power_quandle.pow_comp,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw pow_dist_add,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw apq_neg_pow,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw apq_zero_pow,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw hf.1,
    rw apq_rhd_is_right,
  },
  {
    simp only [apq_adjoint_lift_pre],
    rw hf.2,
  },
end)

def apq_adjoint_lift_is_apq_morphism (f : Q → A) (hf : is_pq_morphism f) : is_apq_morphism (apq_adjoint_lift f hf) :=
begin
  split,
  {
    intros a b,
    induction a,
    induction b,
    refl,
    refl,
    refl,
  },
  {
    intros a n,
    induction a,
    refl,
    refl,
  },
end

end abelianization_pq_adjoint


import .typing .semantics

lemma progress {e : term} {τ : type} : has_type e τ → is_value e ∨ ∃ e', e ⇝ e' :=
begin
  unfold has_type,
  generalize g : @emptyf var type = Γ,
  intro h,
  induction h,

  -- Impossible, variables cannot be typed in ∅
  case has_type_under.var _ _ _ h
  { rw ←g at h, contradiction },

  -- Unit and abstractions are trivially values
  case has_type_under.unit
  { apply or.inl, apply is_value.unit },
  case has_type_under.abs
  { apply or.inl, apply is_value.abs },

  -- Applications always evaluate
  case has_type_under.app _ e₁ e₂ _ _ te₁ _ ih₁ ih₂
  { apply or.inr,
    -- Apply the inductive hypothesis on e₁
    cases (ih₁ g).symm with e₁_steps e₁_iv,

    -- If the LHS steps, apply CONTEXT
    cases e₁_steps with e₁',
    existsi term.app e₁' e₂,
    let E := E.app_left E.hole e₂,
    rw [show term.app e₁  e₂ = E e₁,  from rfl,
        show term.app e₁' e₂ = E e₁', from rfl],
    apply step.context, assumption,

    -- Apply the inductive hypothesis on e₂
    cases (ih₂ g).symm with e₂_steps,

    -- If the RHS steps, apply CONTEXT
    cases e₂_steps with e₂',
    existsi term.app e₁ e₂',
    let E := E.app_right ⟨e₁, e₁_iv⟩ E.hole,
    rw [show term.app e₁ e₂  = E e₂,  from rfl,
        show term.app e₁ e₂' = E e₂', from rfl],
    apply step.context, assumption,

    -- If both are values, then it β-reduces
    cases e₁_iv with x _ e,
    cases subst e e₂ x with e',
    existsi e',
    apply step.beta, repeat { assumption },

    -- Discard superfluous goals
    cases te₁ }
end

lemma has_type_halts_is_value {e : term} {τ : type} : has_type e τ → halts e → is_value e :=
or.resolve_right ∘ progress

lemma ctx_invar {e : term} {τ : type} {Γ : ctx} :
  has_type e τ → ∀ Γ, has_type_under Γ e τ := sorry

-- See technical note in Programming Languages Foundations
-- for why we induct on e as opposed to x:τ' |- e:τ
lemma subst_lemma {x : var} {e e' es : term} {τ τ' : type} {Γ : ctx} :
  has_type_under (extend Γ x τ') e τ → has_type e' τ' → is_subst es e e' x → has_type_under Γ es τ :=
begin
  intros te te' is,

  induction e generalizing Γ τ es,

  case term.unit
  { cases te, cases is,
    apply has_type_under.unit },

  case term.var
  { cases te,

    case has_type_under.var h
    { cases is,

      case is_subst.same_var
      { rw extend_same at h,
        injection h with h,
        rw ←h, apply ctx_invar, assumption, assumption },

      case is_subst.diff_var neq
      { rw extend_diff Γ τ' neq at h,
        apply has_type_under.var, assumption } } },

  case term.abs y _ ih
  { cases te, cases is,

    apply has_type_under.abs,
    apply ih,
    rw extend_comm _ _ _ a_2,
    repeat { assumption } },

  case term.app
  { cases te, cases is,
    let := ih_1 a_2 a_4,
    let := ih_2 a_3 a_5,
    apply has_type_under.app,
    repeat {assumption} }
end

lemma uniqueness {e : term} {τ τ' : type} :
  has_type e τ → has_type e τ' → τ = τ' := sorry

lemma E_lemma {E : E} {e e' : term} {τ τ' : type} :
  has_type (E e) τ → has_type e τ' → has_type e' τ' → has_type (E e') τ :=
begin
  intros tEe te te',

  induction E generalizing τ,

  rw uniqueness tEe te,
  assumption,

  cases tEe,
  let := ih_1 a_2,
  apply has_type_under.app,
  repeat {assumption},

  cases a,
  cases tEe,
  let := ih_1 a_2,
  apply has_type_under.app,
  repeat {assumption},
end

lemma typing_hole {E : E} {e : term} {τ : type} :
  has_type (E e) τ → ∃ τ', has_type e τ' :=
begin
  intro t,
  induction E generalizing τ,

  case E.hole
  { existsi τ, assumption },

  case E.app_left _ _ ih
  { cases t,
    case has_type_under.app _ h
    { exact ih h } },

  case E.app_right v _ ih
  { cases v, cases t,
    case has_type_under.app _ _ h
    { exact ih h } }
end

lemma preservation {e e' : term} {τ : type} :
  has_type e τ → (e ⇝ e') → has_type e' τ :=
begin
  intros t s,
  induction s generalizing τ,

  case step.beta
  { cases t,
    case has_type_under.app _ t'
    { cases t',
      apply subst_lemma,
      repeat { assumption } } },

  case step.context _ _ _ _ ih
  { cases typing_hole t with _ t',
    let := ih t',
    apply E_lemma,
    repeat { assumption } },
end

theorem soundness {e e' : term} {τ : type} :
  has_type e τ → (e ⇝* e') → halts e' → is_value e' ∧ has_type e' τ :=
begin
  intros t s h,
  induction s,

  case rtc.refl
  { apply and.intro,
    apply has_type_halts_is_value,
    repeat { assumption } },

  case rtc.trans _ _ _ s _ ih
  { exact ih (preservation t s) h }
end


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.auto_cases
import tactic.chain
import tactic.norm_cast

namespace tactic

namespace tidy
/-- Tag interactive tactics (locally) with `[tidy]` to add them to the list of default tactics
called by `tidy`. -/
@[user_attribute] meta def tidy_attribute : user_attribute :=
{ name := `tidy,
  descr := "A tactic that should be called by `tidy`." }

add_tactic_doc
{ name                     := "tidy",
  category                 := doc_category.attr,
  decl_names               := [`tactic.tidy.tidy_attribute],
  tags                     := ["search"] }

meta def run_tactics : tactic string :=
do names ← attribute.get_instances `tidy,
   first (names.map name_to_tactic) <|> fail "no @[tidy] tactics succeeded"

@[hint_tactic]
meta def ext1_wrapper : tactic string :=
do ng ← num_goals,
   ext1 [] {apply_cfg . new_goals := new_goals.all},
   ng' ← num_goals,
   return $ if ng' > ng then
     "tactic.ext1 [] {new_goals := tactic.new_goals.all}"
   else "ext1"

meta def default_tactics : list (tactic string) :=
[ reflexivity                                 >> pure "refl",
  `[exact dec_trivial]                        >> pure "exact dec_trivial",
  propositional_goal >> assumption            >> pure "assumption",
  intros1                                     >>= λ ns, pure ("intros " ++ (" ".intercalate $
                                                  ns.map $ λ e, e.to_string)),
  auto_cases,
  `[apply_auto_param]                         >> pure "apply_auto_param",
  `[dsimp at *]                               >> pure "dsimp at *",
  `[simp at *]                                >> pure "simp at *",
  ext1_wrapper,
  fsplit                                      >> pure "fsplit",
  injections_and_clear                        >> pure "injections_and_clear",
  propositional_goal >> (`[solve_by_elim])    >> pure "solve_by_elim",
  `[norm_cast]                                >> pure "norm_cast",
  `[unfold_coes]                              >> pure "unfold_coes",
  `[unfold_aux]                               >> pure "unfold_aux",
  tidy.run_tactics ]

meta structure cfg :=
(trace_result : bool            := ff)
(trace_result_prefix : string   := "Try this: ")
(tactics : list (tactic string) := default_tactics)

declare_trace tidy

meta def core (cfg : cfg := {}) : tactic (list string) :=
do
  results ← chain cfg.tactics,
  when (cfg.trace_result) $
    trace (cfg.trace_result_prefix ++ (", ".intercalate results)),
  return results

end tidy

meta def tidy (cfg : tidy.cfg := {}) := tactic.tidy.core cfg >> skip

namespace interactive
setup_tactic_parser

/-- Use a variety of conservative tactics to solve goals.

`tidy?` reports back the tactic script it found. As an example
```lean
example : ∀ x : unit, x = unit.star :=
begin
  tidy? -- Prints the trace message: "Try this: intros x, exact dec_trivial"
end
```

The default list of tactics is stored in `tactic.tidy.default_tidy_tactics`.
This list can be overridden using `tidy { tactics := ... }`.
(The list must be a `list` of `tactic string`, so that `tidy?`
can report a usable tactic script.)

Tactics can also be added to the list by tagging them (locally) with the
`[tidy]` attribute. -/
meta def tidy (trace : parse $ optional (tk "?")) (cfg : tidy.cfg := {}) :=
tactic.tidy { trace_result := trace.is_some, ..cfg }
end interactive

add_tactic_doc
{ name                     := "tidy",
  category                 := doc_category.tactic,
  decl_names               := [`tactic.interactive.tidy],
  tags                     := ["search", "Try this", "finishing"] }

/-- Invoking the hole command `tidy` ("Use `tidy` to complete the goal") runs the tactic of
the same name, replacing the hole with the tactic script `tidy` produces.
-/
@[hole_command] meta def tidy_hole_cmd : hole_command :=
{ name := "tidy",
  descr := "Use `tidy` to complete the goal.",
  action := λ _, do script ← tidy.core,
    return [("begin " ++ (", ".intercalate script) ++ " end", "by tidy")] }

add_tactic_doc
{ name                     := "tidy",
  category                 := doc_category.hole_cmd,
  decl_names               := [`tactic.tidy_hole_cmd],
  tags                     := ["search"] }

end tactic


/-
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 .regular_open_algebra

universes u v
local attribute [instance] classical.prop_decidable

/- Some facts about Cantor spaces: topological spaces of the form (set α) -/

open topological_space lattice

@[instance, priority 1000]def Prop_space : topological_space Prop := ⊥

instance discrete_Prop : discrete_topology Prop := ⟨rfl⟩

instance product_topology {α : Type*} : topological_space (set α) :=
Pi.topological_space

lemma eq_true_of_provable {p : Prop} (h : p) : (p = true) := by simp[h]

lemma eq_false_of_provable_neg {p : Prop} (h : ¬ p) : (p = false) := by finish

@[reducible, simp]noncomputable def Prop_to_bool (p : Prop) : bool :=
by {haveI := classical.prop_decidable p, by_cases p, exact true, exact false}

@[simp]lemma Prop_to_bool_true : Prop_to_bool true = tt := by simp

@[simp]lemma Prop_to_bool_false : Prop_to_bool false = ff := by simp

noncomputable def equiv_Prop_bool : equiv Prop bool :=
{ to_fun := Prop_to_bool,
  inv_fun := λ b, by {cases b, exact false, exact true},
  left_inv := λ p, by {by_cases p, rw[eq_true_of_provable h, Prop_to_bool_true],
                        rw[eq_false_of_provable_neg h, Prop_to_bool_false]},
  right_inv := λ x, by cases x; finish }

noncomputable instance Prop_encodable : encodable Prop :=
 @encodable.of_equiv _ _ (by apply_instance) equiv_Prop_bool

instance Prop_separable : separable_space Prop :=
{ exists_countable_closure_eq_univ :=
  by {use set.univ, refine ⟨set.countable_encodable _, by simp⟩}}

@[ematch]lemma is_open_of_compl_closed {α : Type*} [topological_space α] {S : set α} (H : (: is_closed (-S) :)) : is_open S :=
by rwa[<-is_closed_compl_iff]

@[ematch]lemma is_closed_of_compl_open {α : Type*} [topological_space α] {S : set α} (H : (: is_open (-S) :)) : is_closed S :=
by rwa[<-is_open_compl_iff]

def clopens (α : Type*) [topological_space α] : Type* := {S : set α // is_clopen S}

instance clopens_lattice {α : Type*} [topological_space α] : lattice (clopens α) :=
{ sup := λ S₁ S₂, ⟨S₁.1 ∪ S₂.1, by {apply is_clopen_union, tidy}⟩,
  le := λ S₁ S₂, S₁.1 ⊆ S₂.1,
  lt := λ S₁ S₂, S₁.1 ⊆ S₂.1 ∧ S₁.1 ≠ S₂.1,
  le_refl := by tidy,
  le_trans := by tidy,
  lt_iff_le_not_le :=
    by {intros; split; intros,
      {split, {from a_1.left},
        intro H, apply a_1.right, refine le_antisymm _ _, from a_1.left, from ‹_›},
        {/- `tidy` says -/ cases a_1, cases b, cases a, cases a_property,
        cases b_property, dsimp at *, fsplit,
        work_on_goal 0 { assumption }, intros a, induction a, solve_by_elim}},
  le_antisymm := by {intros, apply subtype.eq, refine le_antisymm _ _; from ‹_›},
  le_sup_left := by {intros, simp, intros x Hx, left, from ‹_›},
  le_sup_right := by {intros, simp, intros x Hx, right, from ‹_›},
  sup_le := by {intros, intros x Hx, cases Hx, from a_1 ‹_›, from a_2 ‹_›},
  inf := λ S₁ S₂, ⟨S₁.1 ∩ S₂.1, by {apply is_clopen_inter, from S₁.property, from S₂.property}⟩,
  inf_le_left := by {intros, simp, intros x Hx, from Hx.left},
  inf_le_right := by {intros, simp, intros x Hx, from Hx.right},
  le_inf := by {intros, simp, intros x Hx, from ⟨a_1 ‹_›, a_2 ‹_›⟩}}

instance clopens_bounded_lattice {α : Type*} [topological_space α] : bounded_lattice (clopens α) :=
{top := ⟨set.univ, is_clopen_univ⟩,
  le_top := by tidy,
  bot := ⟨∅, is_clopen_empty⟩,
  bot_le := by tidy,
 .. clopens_lattice}

noncomputable def finset_clopens_mk {α : Type*} [topological_space α] {X : finset (set α)} (H : ∀ S ∈ X, is_clopen S) : finset (clopens α) :=
begin
  apply finset.image, show finset _, from finset.attach X,
  intro x, cases x with x Hx, use x, from H x Hx
end

lemma is_clopen_finite_inter {α : Type*} [topological_space α] {X : finset (set α)}
  (H_X : ∀ S ∈ X, is_clopen S) : is_clopen (finset.inf X id) :=
begin
  revert H_X, apply finset.induction_on X, intro _, from is_clopen_univ,
  intros a A H_a H_A IH, simp at ⊢ IH, apply is_clopen_inter,
  from IH a (or.inl rfl), apply H_A, intros S H_S, from IH S (or.inr H_S)
end

lemma is_clopen_finite_inter' {α α' : Type*} [topological_space α] {X : finset α'} {f : α' → set (α)} (H_f : ∀ x ∈ X, is_clopen (f x)) : is_clopen (finset.inf X f) :=
begin
  revert H_f, apply finset.induction_on X, intro _, from is_clopen_univ,
  intros a A H_a H_A IH, simp at ⊢ IH, apply is_clopen_inter,
  from IH a (or.inl rfl), apply H_A, intros S H_S, from IH S (or.inr H_S)
end

namespace cantor_space
section cantor_space
variables {α : Type*}

def principal_open (x : α) : set (set α) := {S | x ∈ S}

def co_principal_open (x : α) : set (set α) := {S | x ∉ S}

@[simp]lemma neg_principal_open {x : α} : co_principal_open x = -(principal_open x)  :=
by unfold principal_open; refl

@[simp]lemma neg_co_principal_open {x : α} : - (co_principal_open x) = principal_open x :=
by {simp[principal_open]}

-- lemma is_open_induced_iff' {α β : Type*} {f : α → β} [t : topological_space β] {s : set α} {f : α → β} :
--    (∃t, is_open t ∧ f ⁻¹' t = s) ↔ @topological_space.is_open α (t.induced f) s := is_open_induced_iff.symm

def opens_over (x : α) : set(set(set α)) := {principal_open x, co_principal_open x, set.univ, ∅}

@[simp]lemma principal_open_mem_opens_over {x : α} : principal_open x ∈ opens_over x :=
by {right,right,right, from set.mem_singleton _}

@[simp]lemma co_principal_open_mem_opens_over {x : α} : co_principal_open x ∈ opens_over x :=
by {right,right,left, refl}

@[simp]lemma univ_mem_opens_over {x : α} : set.univ ∈ opens_over x :=
by {right,left, refl}

@[simp]lemma empty_mem_opens_over {x : α} : ∅ ∈ opens_over x :=
by {left, refl}

/-- Given a : α, τ is the topology induced by pulling back the
  discrete topology on Prop along the a'th projection map -/
def τ (a : α) : topological_space (set α) :=
induced (λS, a ∈ S) (by apply_instance : topological_space Prop)

lemma fiber_over_false {α : Type*} {a : α} : (λ x : set α, a ∈ x) ⁻¹' {false} = {y | a ∉ y} :=
begin
  ext, split; simp[set.mem_preimage]
end

lemma fiber_over_true {α : Type*} {a : α} : (λ x : set α, a ∈ x) ⁻¹' {true} = {y | a ∈ y} :=
begin
  ext, split; simp[set.mem_preimage]
end

lemma opens_over_sub_τ (a : α) : opens_over a ⊆ (τ a).is_open :=
begin
  unfold τ, intros S HS, unfold opens_over at HS,
  repeat{cases HS}, apply is_open_empty, apply _root_.is_open_univ,
  apply is_open_induced_iff.mpr, fsplit, exact {false}, fsplit,
  apply is_open_discrete,
    {ext1, ext1, dsimp at *, fsplit,
      work_on_goal 0 { intros a_1 a_2, cases a_1,
      work_on_goal 1 { assumption } }, work_on_goal 1 { intros a_1 },
    rwa[<-a_1], rwa[fiber_over_false]},
  apply is_open_induced_iff.mpr, fsplit, exact {true}, fsplit,
  apply is_open_discrete,
    {ext1, ext1, fsplit,
      work_on_goal 0 { intros a_1, cases a_1, work_on_goal 0 { cc },
      dsimp at a_1, cases a_1 }, intros a_1, rwa[fiber_over_true]},
end

lemma opens_over_le_τ (a : α) : τ a ≤ generate_from (opens_over a) :=
by { rw [le_generate_from_iff_subset_is_open], exact opens_over_sub_τ a }

lemma τ_le_product_topology (a : α) : product_topology ≤ τ a :=
infi_le _ _

lemma le_iff_opens_sub {β : Type*} {τ₁ τ₂ : topological_space β} :
  τ₂ ≤ τ₁ ↔ {S | τ₁.is_open S} ⊆ {S | τ₂.is_open S} := by refl

lemma τ_le_opens_over (a : α) : generate_from (opens_over a) ≤ τ a :=
begin
  apply le_iff_opens_sub.mpr, rintros X ⟨H_w, H_h_left, rfl⟩,
   by_cases htrue : true ∈ H_w; by_cases hfalse : false ∈ H_w,
   { constructor, unfold opens_over, repeat{split}, right,left,
    ext, by_cases a ∈ x, split, from λ _, trivial, intro, simp[h], from ‹_›,
    split, from λ _, trivial, intro, simp[h], from ‹_›},
   { constructor, unfold opens_over, repeat{split}, right, right, right,
     simp, ext, by_cases a ∈ x, split, intro H, simp[principal_open], from ‹_›,
     intro H, simp*, split; intros, simp [h, hfalse] at a_1, cases a_1,
     simp[principal_open, *, -a_1] at a_1, cases a_1},
   { constructor, unfold opens_over, repeat{split}, right, right, left,
     simp, ext, split; intros; simp[*, -a_1] at a_1; by_cases a ∈ x,
     tidy {tactics := with_cc}, },
   { have : H_w = ∅, ext, split; intros, by_cases x; simp* at a_1; cases a_1, cases a_1,
    subst this, simp, by apply @is_open_empty _ (generate_from _)}
end

@[simp]lemma is_open_generated_from_basic {β : Type*} [topological_space β] {s : set (set β)} {x ∈ s} :
  is_open (generate_from s) x := by {constructor, from ‹_›}

lemma is_open_principal_open {a : α} : is_open (principal_open a) :=
by { apply (le_trans (τ_le_product_topology _) (opens_over_le_τ a)), simp[opens_over] }

lemma is_open_co_principal_open {a : α} : is_open (co_principal_open a) :=
by { apply (le_trans (τ_le_product_topology _) (opens_over_le_τ a)), simp[opens_over] }

lemma is_closed_principal_open {a : α} : is_closed (principal_open a) :=
by {apply is_closed_of_compl_open, from is_open_co_principal_open}

lemma is_closed_co_principal_open {a : α} : is_closed (co_principal_open a) :=
by {apply is_closed_of_compl_open,
    simp only [neg_principal_open, lattice.neg_neg], from is_open_principal_open}

lemma is_clopen_principal_open {a : α} : is_clopen (principal_open a) :=
  ⟨is_open_principal_open, is_closed_principal_open⟩

lemma is_clopen_co_principal_open {a : α} : is_clopen (co_principal_open a) :=
  ⟨is_open_co_principal_open, is_closed_co_principal_open⟩

@[reducible]def principal_open_finset (F : finset α) : set (set α) := {S | F.to_set ⊆ S}

lemma mem_principal_open_finset_iff {F : finset α} {x : set α} : x ∈ (principal_open_finset F) ↔ (↑F : set α) ⊆ x := by refl

@[simp]lemma principal_open_finset_insert {F : finset α} {a : α} : principal_open_finset (insert a F) = principal_open_finset {a} ∩ principal_open_finset F :=
begin
  ext x, /- `tidy` says -/ dsimp at *, fsplit, work_on_goal 0 { intros a_1, fsplit, work_on_goal 0 { intros a_2 a_3, cases a_3, work_on_goal 0 { induction a_3 }, work_on_goal 1 { cases a_3 } }, work_on_goal 1 { intros a_2 a_3 } }, work_on_goal 2 { intros a_1 a_2 a_3, cases a_1 },
    { unfold finset.to_set at a_1, exact a_1 (by simp : a_2 ∈ _) },
    { unfold finset.to_set at a_1, exact a_1 (by finish : a_2 ∈ _) },
    { unfold finset.to_set at *, simp[set.mem_insert_iff] at a_3,
      cases a_3 with a_3₁ a_3₂,
        { finish },
        { exact a_1_right ‹_› } }
end

lemma principal_open_finset_eq_inter (F : finset α) : principal_open_finset F = (finset.inf F (principal_open)) :=
begin
  apply finset.induction_on F,
    {tidy},
  intros a A h_a IH, simp, rw[<-IH], ext, split; intros,
  tidy, apply a_1_left, simp[finset.to_set]
end

@[reducible] def co_principal_open_finset (F : finset α) : set (set α) := {S | F.to_set ⊆ (-S)}

@[simp]lemma co_principal_open_finset_insert {F : finset α} {a : α} : co_principal_open_finset (insert a F) = co_principal_open_finset {a} ∩ co_principal_open_finset F :=
begin
  ext x, /- `tidy` says -/ dsimp at *, fsplit, work_on_goal 0 { intros a_1, fsplit, work_on_goal 0 { intros a_2 a_3, cases a_3, work_on_goal 0 { induction a_3 }, work_on_goal 1 { cases a_3 } }, work_on_goal 1 { intros a_2 a_3 } }, work_on_goal 2 { intros a_1 a_2 a_3, cases a_1 },
    { unfold finset.to_set at a_1, exact a_1 (by simp : a_2 ∈ _) },
    { unfold finset.to_set at a_1, exact a_1 (by finish : a_2 ∈ _) },
    { unfold finset.to_set at *, simp[set.mem_insert_iff] at a_3,
      cases a_3 with a_3₁ a_3₂,
        { finish },
        { exact a_1_right ‹_› } }
end

lemma co_principal_open_finset_eq_inter (F : finset α) : co_principal_open_finset F = (finset.inf F (co_principal_open)) :=
begin
  apply finset.induction_on F,
    {tidy},
  intros a A h_a IH, simp, rw[<-IH], ext, split; intros,
  tidy, apply a_1_left, simp[finset.to_set], from a_1
end

lemma is_clopen_principal_open_finset (F : finset α) : is_clopen (principal_open_finset F) :=
begin
  rw[principal_open_finset_eq_inter], apply is_clopen_finite_inter',
  from λ _ _, is_clopen_principal_open
end

lemma is_clopen_co_principal_open_finset (F : finset α) : is_clopen (co_principal_open_finset F) :=
begin
  rw[co_principal_open_finset_eq_inter], apply is_clopen_finite_inter',
  from λ _ _, is_clopen_co_principal_open
end

lemma product_topology_generate_from : (product_topology : topological_space (set α)) = generate_from (⋃(a : α), opens_over a) :=
begin
  apply le_antisymm,
  { unfold product_topology Pi.topological_space,
    apply generate_from_mono,
    intros X HX, rcases HX with ⟨W, ⟨H₁, H₂⟩⟩, simp, cases H₁ with a Ha,
    use τ a, split, use a, refl, apply opens_over_le_τ a, constructor, cc },
  refine le_infi _, intro a,
  refine le_trans _ (τ_le_opens_over a), apply generate_from_mono,
  intros X H, constructor, simp, use a, exact H
end

def standard_basis : set (set (set α)) :=
{T : set (set α) | ∃ p_ins p_out : finset α, T = (finset.inf p_ins principal_open) ∩ (finset.inf p_out co_principal_open) ∧ p_ins ∩ p_out = ∅} ∪ {∅}

lemma ins₁_out₂_disjoint {x : set α} {p_ins₁ p_out₁ p_ins₂ p_out₂ : finset α}
  (H_mem₁ : x ∈ finset.inf p_ins₁ principal_open ∩ finset.inf p_out₁ co_principal_open)
  (H_mem₂ : x ∈ finset.inf p_ins₂ principal_open ∩ finset.inf p_out₂ co_principal_open)
  (H_disjoint₁ : p_ins₁ ∩ p_out₁ = ∅) (H_disjoint₂ : p_ins₂ ∩ p_out₂ = ∅)
  {a : α} (Ha_left : a ∈ p_ins₁)
  (Ha_right : a ∈ p_out₂) : false :=
begin
  rw[<-principal_open_finset_eq_inter, <-co_principal_open_finset_eq_inter] at H_mem₁ H_mem₂,
  suffices : a ∉ x ∧ a ∈ x, from (not_and_self _).mp this, split,
  rw[set.mem_inter_iff] at H_mem₂, apply H_mem₂.right ‹_›,
  rw[set.mem_inter_iff] at H_mem₁, apply H_mem₁.left ‹_›
end

@[simp]lemma principal_open_mem_standard_basis {a : α} : (principal_open a) ∈ (@standard_basis α) :=
by {simp[standard_basis], right, use {a}, use ∅, tidy}

@[simp]lemma co_principal_open_mem_standard_basis {a : α} : co_principal_open a ∈ (@standard_basis α) :=
by {simp[standard_basis], right, use ∅, use {a}, tidy}

lemma univ_mem_standard_basis : set.univ ∈ (@standard_basis α) :=
by {simp[standard_basis], use ∅, use ∅, tidy}

lemma intersection_standard_basis_nonempty' {α : Type*} {p_ins p_out : finset α} {H : p_ins ∩ p_out = ∅} : ∃ X, X ∈ finset.inf p_ins principal_open ∩ finset.inf p_out co_principal_open :=
begin
  use p_ins.to_set, rw[<-principal_open_finset_eq_inter, <-co_principal_open_finset_eq_inter],
  simp[finset.to_set], intros x Hx, simp, intro H', apply ((finset.ext).mp H x).mp,
  rw[finset.mem_inter], from ⟨‹_›,‹_›⟩
end

lemma intersection_standard_basis_nonempty {α : Type*} {T : set (set α)} {p_ins p_out : finset α} {H_eq : T = finset.inf p_ins principal_open ∩ finset.inf p_out co_principal_open} {H : p_ins ∩ p_out = ∅} : ¬⋂₀ finset.to_set (finset.image principal_open p_ins ∪ finset.image co_principal_open p_out) = ∅ :=
begin
  intro H', simp[finset.to_set] at H', replace H' := (set.ext_iff _ _).mp H',
  cases @intersection_standard_basis_nonempty' _ p_ins p_out ‹_› with a H_a, subst H_eq,
  rw[<-principal_open_finset_eq_inter, <-co_principal_open_finset_eq_inter] at H_a, cases H_a,
  specialize H' a, apply H'.mp, simp, simp[not_forall] at H',
  rcases H' with ⟨s, ⟨⟨w', Hw'_1, Hw'_2⟩, H_a'⟩⟩; intros t Ht; cases Ht;
  rcases Ht with ⟨w, H_w, H_w_eq⟩; subst H_w_eq, tidy
end

lemma standard_basis_reindex {α : Type*} {T : set (set α)} {p_ins p_out : finset α} {H_eq : T = finset.inf p_ins principal_open ∩ finset.inf p_out co_principal_open} {H : p_ins ∩ p_out = ∅} : ⋂₀ finset.to_set (finset.image principal_open p_ins ∪ finset.image co_principal_open p_out) = T :=
begin
  subst H_eq, rw[<-principal_open_finset_eq_inter, <-co_principal_open_finset_eq_inter],
  simp[finset.to_set], ext; split; intro H',
    {rw[set.mem_sInter] at H',

    simp[principal_open_finset, co_principal_open_finset], split,
    intros a Ha, specialize H' (principal_open a), apply H',
    right, use a, from ⟨‹_›, rfl⟩,

    intros a Ha, specialize H' (co_principal_open a), apply H',
    left, use a, from ⟨‹_›, rfl⟩,},

    {rw[set.mem_sInter], intros T hT, simp at hT, cases hT,
    simp[finset.to_set] at H', tidy}
end

lemma is_topological_basis_standard_basis : @is_topological_basis (set α) _ standard_basis :=
begin
  repeat{split},
  {intros t₁ H₁ t₂ H₂ x Hx, cases H₁; cases H₂,
    {rcases H₁ with ⟨p_ins₁, p_out₁, H₁, H₁'⟩, rcases H₂ with ⟨p_ins₂, p_out₂, H₂, H₂'⟩,
      use (finset.inf (p_ins₁ ∪ p_ins₂) principal_open) ∩ (finset.inf (p_out₁ ∪ p_out₂) co_principal_open), split, swap, split,
    split, rw[<-principal_open_finset_eq_inter], unfold principal_open_finset,
    simp, intros a Ha, simp[finset.to_set] at Ha, subst H₁, subst H₂,
    simp at Hx, rcases Hx with ⟨⟨Hx1, Hx2⟩, Hx3, Hx4⟩, cases Ha,
    rw[<-principal_open_finset_eq_inter] at Hx1, apply Hx1, from Ha,
    rw[<-principal_open_finset_eq_inter] at Hx3, apply Hx3, from Ha,

    rw[<-co_principal_open_finset_eq_inter], unfold co_principal_open_finset,
    simp, intros a Ha, simp[finset.to_set] at Ha, subst H₁, subst H₂,
    simp at Hx, rcases Hx with ⟨⟨Hx1, Hx2⟩, Hx3, Hx4⟩, cases Ha,
    rw[<-co_principal_open_finset_eq_inter] at Hx2, apply Hx2, from Ha,
    rw[<-co_principal_open_finset_eq_inter] at Hx4, apply Hx4, from Ha,

    rw[<-principal_open_finset_eq_inter, <-co_principal_open_finset_eq_inter],
    intros a Ha, unfold principal_open_finset co_principal_open_finset at Ha,
    cases Ha with Ha₁ Ha₂, substs H₁ H₂, split,
    rw[<-principal_open_finset_eq_inter, <-co_principal_open_finset_eq_inter],
    split, intros x Hx, apply Ha₁, simp[finset.to_set], left, from Hx,
    intros x Hx, apply Ha₂, simp[finset.to_set], left, from Hx,

    rw[<-principal_open_finset_eq_inter, <-co_principal_open_finset_eq_inter],
    split, intros x Hx, apply Ha₁, simp[finset.to_set], right, from Hx,
    intros x Hx, apply Ha₂, simp[finset.to_set], right, from Hx,

    use (p_ins₁ ∪ p_ins₂), use (p_out₁ ∪ p_out₂), refine ⟨rfl, _⟩,
    simp only [finset.inter_distrib_left, finset.inter_distrib_right],
    ext1, split; intro Ha, swap, cases Ha, simp [H₁', H₂'] at Ha,
    repeat{cases Ha}; exfalso; substs H₁ H₂; cases Hx,
    from ins₁_out₂_disjoint Hx_left Hx_right ‹_› ‹_› Ha_left Ha_right,
    from ins₁_out₂_disjoint Hx_right Hx_left ‹_› ‹_› Ha_right Ha_left
    },
    {replace H₂ := set.mem_singleton_iff.mp H₂, subst H₂, exfalso, simpa using Hx},
    {replace H₁ := set.mem_singleton_iff.mp H₁, subst H₁, exfalso, simpa using Hx},
    {replace H₁ := set.mem_singleton_iff.mp H₁, subst H₁, exfalso, simpa using Hx}
  },
  {ext, split; intros, trivial, rw[set.mem_sUnion], use set.univ,
    use univ_mem_standard_basis},
  {rw[product_topology_generate_from], refine le_antisymm _ _, swap,

    {apply generate_from_mono,
     intros X H_X, rcases H_X with ⟨w, ⟨a, H_w⟩, H_X⟩,
     unfold standard_basis, simp, subst H_w, repeat{cases H_X}, left, refl,
     right, use ∅, use ∅, {simp, refl}, right, use ∅, use {a},
     {/- `tidy` says -/ simp, ext1,   fsplit, work_on_goal 0
     { intros a_1, fsplit, work_on_goal 0 { fsplit },
     fsplit, work_on_goal 0 { assumption },  fsplit },
     intros a_1 a_2, cases a_1, cases a_1_right, solve_by_elim}, right, use {a}, use ∅,
     {/- `tidy` says -/ simp, ext1, fsplit, work_on_goal 0
     { intros a_1, fsplit, work_on_goal 0 { fsplit, work_on_goal 0 { assumption }, fsplit },
     fsplit }, intros a_1, cases a_1, cases a_1_left, assumption}},

  {
  apply le_generate_from_iff_subset_is_open.mpr, intros T hT, unfold standard_basis at hT,
  cases hT with hT h_empty, swap, rw[set.mem_singleton_iff] at h_empty, subst h_empty,
  apply @is_open_empty _ (generate_from _),

  simp, have := is_topological_basis_of_subbasis (product_topology_generate_from), swap, from α,
  rw[<-product_topology_generate_from],
  apply is_open_of_is_topological_basis this, simp,
  rcases hT with ⟨p_ins, p_out, H_eq, H⟩,
  use ((finset.image principal_open p_ins) ∪ (finset.image co_principal_open p_out)).to_set,
  split, split, from finset.finite_to_set _, split,
  apply finset.induction_on p_ins, apply finset.induction_on p_out,
  simp, intros x Hx, cases Hx, intros a A H_a H_A, simp, intros x Hx,
  simp[finset.to_set] at Hx, cases Hx, rw[set.mem_Union], use a, rw[Hx],
  rw[<-neg_principal_open], from co_principal_open_mem_opens_over,
  rw[set.mem_Union], cases Hx with a Hx, use a, rw[<-Hx.right],
  rw[<-neg_principal_open], from co_principal_open_mem_opens_over,
  intros a A H_a H_A, simp, intros x Hx, simp[finset.to_set] at Hx, cases Hx,
  rw[Hx], rw[set.mem_Union], use a, from principal_open_mem_opens_over,
  cases Hx with Hx Hx', rw[set.mem_Union], cases Hx with a Hx,
  use a, rw[<-Hx.right, <-neg_principal_open], from co_principal_open_mem_opens_over,
  cases Hx' with a Hx, rw[set.mem_Union],
  use a, rw[<-Hx.right], from principal_open_mem_opens_over,

  by {apply intersection_standard_basis_nonempty; from ‹_›},

  by {apply standard_basis_reindex; from ‹_›}
}}
end

open cardinal

lemma countable_chain_condition_set {α : Type u} : countable_chain_condition (set α) :=
begin
  apply countable_chain_condition_pi, intros s hs,
  apply countable_chain_condition_of_countable, apply le_of_lt,
  convert @power_lt_omega (mk (ulift Prop)) (mk s) _ _ using 1,
  { refine quotient.sound ⟨equiv.arrow_congr (equiv.refl _) equiv.ulift.symm⟩ },
  { rw [prop_eq_two], convert cardinal.nat_lt_omega 2, rw [nat.cast_bit0, nat.cast_one] },
  rwa lt_omega_iff_finite
end

end cantor_space
end cantor_space


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.finite_limits
import order.complete_lattice

universes u

open category_theory
open category_theory.limits

namespace category_theory.limits.complete_lattice

variables {α : Type u}

@[priority 100] -- see Note [lower instance priority]
instance has_finite_limits_of_semilattice_inf_top [semilattice_inf_top α] :
  has_finite_limits α :=
⟨λ J 𝒥₁ 𝒥₂, by exactI
  { has_limit := λ F, has_limit.mk
    { cone :=
      { X := finset.univ.inf F.obj,
        π := { app := λ j, hom_of_le (finset.inf_le (fintype.complete _)) } },
      is_limit := { lift := λ s, hom_of_le (finset.le_inf (λ j _, (s.π.app j).down.down)) } } }⟩

@[priority 100] -- see Note [lower instance priority]
instance has_finite_colimits_of_semilattice_sup_bot [semilattice_sup_bot α] :
  has_finite_colimits α :=
⟨λ J 𝒥₁ 𝒥₂, by exactI
  { has_colimit := λ F, has_colimit.mk
    { cocone :=
      { X := finset.univ.sup F.obj,
        ι := { app := λ i, hom_of_le (finset.le_sup (fintype.complete _)) } },
      is_colimit := { desc := λ s, hom_of_le (finset.sup_le (λ j _, (s.ι.app j).down.down)) } } }⟩

variables {J : Type u} [small_category J]

/--
The limit cone over any functor into a complete lattice.
-/
def limit_cone [complete_lattice α] (F : J ⥤ α) : limit_cone F :=
{ cone :=
  { X := infi F.obj,
    π :=
    { app := λ j, hom_of_le (complete_lattice.Inf_le _ _ (set.mem_range_self _)) } },
  is_limit :=
  { lift := λ s, hom_of_le (complete_lattice.le_Inf _ _
    begin rintros _ ⟨j, rfl⟩, exact le_of_hom (s.π.app j), end) } }

/--
The colimit cocone over any functor into a complete lattice.
-/
def colimit_cocone [complete_lattice α] (F : J ⥤ α) : colimit_cocone F :=
{ cocone :=
  { X := supr F.obj,
    ι :=
    { app := λ j, hom_of_le (complete_lattice.le_Sup _ _ (set.mem_range_self _)) } },
  is_colimit :=
  { desc := λ s, hom_of_le (complete_lattice.Sup_le _ _
    begin rintros _ ⟨j, rfl⟩, exact le_of_hom (s.ι.app j), end) } }

-- It would be nice to only use the `Inf` half of the complete lattice, but
-- this seems not to have been described separately.
@[priority 100] -- see Note [lower instance priority]
instance has_limits_of_complete_lattice [complete_lattice α] : has_limits α :=
{ has_limits_of_shape := λ J 𝒥, by exactI
  { has_limit := λ F, has_limit.mk (limit_cone F) } }

@[priority 100] -- see Note [lower instance priority]
instance has_colimits_of_complete_lattice [complete_lattice α] : has_colimits α :=
{ has_colimits_of_shape := λ J 𝒥, by exactI
  { has_colimit := λ F, has_colimit.mk (colimit_cocone F) } }

noncomputable theory
variables [complete_lattice α] (F : J ⥤ α)

/--
The limit of a functor into a complete lattice is the infimum of the objects in the image.
-/
def limit_iso_infi : limit F ≅ infi F.obj :=
is_limit.cone_point_unique_up_to_iso (limit.is_limit F) (limit_cone F).is_limit

@[simp] lemma limit_iso_infi_hom (j : J) :
  (limit_iso_infi F).hom ≫ hom_of_le (infi_le _ j) = limit.π F j := by tidy
@[simp] lemma limit_iso_infi_inv (j : J) :
  (limit_iso_infi F).inv ≫ limit.π F j = hom_of_le (infi_le _ j) := rfl

/--
The colimit of a functor into a complete lattice is the supremum of the objects in the image.
-/
def colimit_iso_supr : colimit F ≅ supr F.obj :=
is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit F) (colimit_cocone F).is_colimit

@[simp] lemma colimit_iso_supr_hom (j : J) :
  colimit.ι F j ≫ (colimit_iso_supr F).hom = hom_of_le (le_supr _ j) := rfl
@[simp] lemma colimit_iso_supr_inv (j : J) :
  hom_of_le (le_supr _ j) ≫ (colimit_iso_supr F).inv = colimit.ι F j := by tidy

end category_theory.limits.complete_lattice


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.finite_limits
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.terminal

universes v u

open category_theory
namespace category_theory.limits

variables (C : Type u) [category.{v} C]

/--
A category has finite products if there is a chosen limit for every diagram
with shape `discrete J`, where we have `[decidable_eq J]` and `[fintype J]`.
-/
-- We can't simply make this an abbreviation, as we do with other `has_Xs` limits typeclasses,
-- because of https://github.com/leanprover-community/lean/issues/429
class has_finite_products : Prop :=
(out (J : Type v) [decidable_eq J] [fintype J] : has_limits_of_shape (discrete J) C)

instance has_limits_of_shape_discrete
  (J : Type v) [fintype J] [has_finite_products C] :
  has_limits_of_shape (discrete J) C :=
by { haveI := @has_finite_products.out C _ _ J (classical.dec_eq _), apply_instance }

/-- If `C` has finite limits then it has finite products. -/
lemma has_finite_products_of_has_finite_limits [has_finite_limits C] : has_finite_products C :=
⟨λ J 𝒥₁ 𝒥₂, by { resetI, apply_instance }⟩

/--
If a category has all products then in particular it has finite products.
-/
lemma has_finite_products_of_has_products [has_products C] : has_finite_products C :=
⟨by apply_instance⟩

/--
A category has finite coproducts if there is a chosen colimit for every diagram
with shape `discrete J`, where we have `[decidable_eq J]` and `[fintype J]`.
-/
class has_finite_coproducts : Prop :=
(out (J : Type v) [decidable_eq J] [fintype J] : has_colimits_of_shape (discrete J) C)

attribute [class] has_finite_coproducts

instance has_colimits_of_shape_discrete
  (J : Type v) [fintype J] [has_finite_coproducts C] :
  has_colimits_of_shape (discrete J) C :=
by { haveI := @has_finite_coproducts.out C _ _ J (classical.dec_eq _), apply_instance }

/-- If `C` has finite colimits then it has finite coproducts. -/
lemma has_finite_coproducts_of_has_finite_colimits [has_finite_colimits C] :
  has_finite_coproducts C :=
⟨λ J 𝒥₁ 𝒥₂, by { resetI, apply_instance }⟩

/--
If a category has all coproducts then in particular it has finite coproducts.
-/
lemma has_finite_coproducts_of_has_coproducts [has_coproducts C] : has_finite_coproducts C :=
⟨by apply_instance⟩

end category_theory.limits


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Ken Lee, Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.ring
import Mathlib.algebra.big_operators.basic
import Mathlib.data.fintype.basic
import Mathlib.data.int.gcd
import Mathlib.data.set.disjointed
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Coprime elements of a ring

## Main definitions

* `is_coprime x y`: that `x` and `y` are coprime, defined to be the existence of `a` and `b` such
that `a * x + b * y = 1`. Note that elements with no common divisors are not necessarily coprime,
e.g., the multivariate polynomials `x₁` and `x₂` are not coprime.

-/

/-- The proposition that `x` and `y` are coprime, defined to be the existence of `a` and `b` such
that `a * x + b * y = 1`. Note that elements with no common divisors are not necessarily coprime,
e.g., the multivariate polynomials `x₁` and `x₂` are not coprime. -/
@[simp] def is_coprime {R : Type u} [comm_semiring R] (x : R) (y : R) :=
  ∃ (a : R), ∃ (b : R), a * x + b * y = 1

theorem nat.is_coprime_iff_coprime {m : ℕ} {n : ℕ} : is_coprime ↑m ↑n ↔ nat.coprime m n := sorry

theorem is_coprime.symm {R : Type u} [comm_semiring R] {x : R} {y : R} (H : is_coprime x y) :
    is_coprime y x :=
  sorry

theorem is_coprime_comm {R : Type u} [comm_semiring R] {x : R} {y : R} :
    is_coprime x y ↔ is_coprime y x :=
  { mp := is_coprime.symm, mpr := is_coprime.symm }

theorem is_coprime_self {R : Type u} [comm_semiring R] {x : R} : is_coprime x x ↔ is_unit x := sorry

theorem is_coprime_zero_left {R : Type u} [comm_semiring R] {x : R} : is_coprime 0 x ↔ is_unit x :=
  sorry

theorem is_coprime_zero_right {R : Type u} [comm_semiring R] {x : R} : is_coprime x 0 ↔ is_unit x :=
  iff.trans is_coprime_comm is_coprime_zero_left

theorem is_coprime_one_left {R : Type u} [comm_semiring R] {x : R} : is_coprime 1 x := sorry

theorem is_coprime_one_right {R : Type u} [comm_semiring R] {x : R} : is_coprime x 1 := sorry

theorem is_coprime.dvd_of_dvd_mul_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (H1 : is_coprime x z) (H2 : x ∣ y * z) : x ∣ y :=
  sorry

theorem is_coprime.dvd_of_dvd_mul_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (H1 : is_coprime x y) (H2 : x ∣ y * z) : x ∣ z :=
  sorry

theorem is_coprime.mul_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (H1 : is_coprime x z) (H2 : is_coprime y z) : is_coprime (x * y) z :=
  sorry

theorem is_coprime.mul_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (H1 : is_coprime x y) (H2 : is_coprime x z) : is_coprime x (y * z) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (y * z))) (propext is_coprime_comm)))
    (is_coprime.mul_left
      (eq.mp (Eq._oldrec (Eq.refl (is_coprime x y)) (propext is_coprime_comm)) H1)
      (eq.mp (Eq._oldrec (Eq.refl (is_coprime x z)) (propext is_coprime_comm)) H2))

theorem is_coprime.prod_left {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R}
    {t : finset I} :
    (∀ (i : I), i ∈ t → is_coprime (s i) x) → is_coprime (finset.prod t fun (i : I) => s i) x :=
  sorry

theorem is_coprime.prod_right {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R}
    {t : finset I} :
    (∀ (i : I), i ∈ t → is_coprime x (s i)) → is_coprime x (finset.prod t fun (i : I) => s i) :=
  sorry

theorem is_coprime.mul_dvd {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (H : is_coprime x y) (H1 : x ∣ z) (H2 : y ∣ z) : x * y ∣ z :=
  sorry

theorem finset.prod_dvd_of_coprime {R : Type u} [comm_semiring R] {z : R} {I : Type v} {s : I → R}
    {t : finset I} (Hs : set.pairwise_on (↑t) (is_coprime on s))
    (Hs1 : ∀ (i : I), i ∈ t → s i ∣ z) : (finset.prod t fun (x : I) => s x) ∣ z :=
  sorry

theorem fintype.prod_dvd_of_coprime {R : Type u} [comm_semiring R] {z : R} {I : Type v} {s : I → R}
    [fintype I] (Hs : pairwise (is_coprime on s)) (Hs1 : ∀ (i : I), s i ∣ z) :
    (finset.prod finset.univ fun (x : I) => s x) ∣ z :=
  finset.prod_dvd_of_coprime (pairwise.pairwise_on Hs ↑finset.univ)
    fun (i : I) (_x : i ∈ finset.univ) => Hs1 i

theorem is_coprime.of_mul_left_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (H : is_coprime (x * y) z) : is_coprime x z :=
  sorry

theorem is_coprime.of_mul_left_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (H : is_coprime (x * y) z) : is_coprime y z :=
  is_coprime.of_mul_left_left (eq.mp (Eq._oldrec (Eq.refl (is_coprime (x * y) z)) (mul_comm x y)) H)

theorem is_coprime.of_mul_right_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (H : is_coprime x (y * z)) : is_coprime x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x y)) (propext is_coprime_comm)))
    (is_coprime.of_mul_left_left
      (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (y * z))) (propext is_coprime_comm)) H))

theorem is_coprime.of_mul_right_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (H : is_coprime x (y * z)) : is_coprime x z :=
  is_coprime.of_mul_right_left
    (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (y * z))) (mul_comm y z)) H)

theorem is_coprime.mul_left_iff {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} :
    is_coprime (x * y) z ↔ is_coprime x z ∧ is_coprime y z :=
  sorry

theorem is_coprime.mul_right_iff {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} :
    is_coprime x (y * z) ↔ is_coprime x y ∧ is_coprime x z :=
  sorry

theorem is_coprime.prod_left_iff {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R}
    {t : finset I} :
    is_coprime (finset.prod t fun (i : I) => s i) x ↔ ∀ (i : I), i ∈ t → is_coprime (s i) x :=
  sorry

theorem is_coprime.prod_right_iff {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R}
    {t : finset I} :
    is_coprime x (finset.prod t fun (i : I) => s i) ↔ ∀ (i : I), i ∈ t → is_coprime x (s i) :=
  sorry

theorem is_coprime.of_prod_left {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R}
    {t : finset I} (H1 : is_coprime (finset.prod t fun (i : I) => s i) x) (i : I) (hit : i ∈ t) :
    is_coprime (s i) x :=
  iff.mp is_coprime.prod_left_iff H1 i hit

theorem is_coprime.of_prod_right {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R}
    {t : finset I} (H1 : is_coprime x (finset.prod t fun (i : I) => s i)) (i : I) (hit : i ∈ t) :
    is_coprime x (s i) :=
  iff.mp is_coprime.prod_right_iff H1 i hit

theorem is_coprime.pow_left {R : Type u} [comm_semiring R] {x : R} {y : R} {m : ℕ}
    (H : is_coprime x y) : is_coprime (x ^ m) y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (x ^ m) y)) (Eq.symm (finset.card_range m))))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (is_coprime (x ^ finset.card (finset.range m)) y))
          (Eq.symm (finset.prod_const x))))
      (is_coprime.prod_left fun (_x : ℕ) (_x : _x ∈ finset.range m) => H))

theorem is_coprime.pow_right {R : Type u} [comm_semiring R] {x : R} {y : R} {n : ℕ}
    (H : is_coprime x y) : is_coprime x (y ^ n) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (y ^ n))) (Eq.symm (finset.card_range n))))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (is_coprime x (y ^ finset.card (finset.range n))))
          (Eq.symm (finset.prod_const y))))
      (is_coprime.prod_right fun (_x : ℕ) (_x : _x ∈ finset.range n) => H))

theorem is_coprime.pow {R : Type u} [comm_semiring R] {x : R} {y : R} {m : ℕ} {n : ℕ}
    (H : is_coprime x y) : is_coprime (x ^ m) (y ^ n) :=
  is_coprime.pow_right (is_coprime.pow_left H)

theorem is_coprime.is_unit_of_dvd {R : Type u} [comm_semiring R] {x : R} {y : R}
    (H : is_coprime x y) (d : x ∣ y) : is_unit x :=
  sorry

theorem is_coprime.map {R : Type u} [comm_semiring R] {x : R} {y : R} (H : is_coprime x y)
    {S : Type v} [comm_semiring S] (f : R →+* S) : is_coprime (coe_fn f x) (coe_fn f y) :=
  sorry

theorem is_coprime.of_add_mul_left_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (h : is_coprime (x + y * z) y) : is_coprime x y :=
  sorry

theorem is_coprime.of_add_mul_right_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (h : is_coprime (x + z * y) y) : is_coprime x y :=
  is_coprime.of_add_mul_left_left
    (eq.mp (Eq._oldrec (Eq.refl (is_coprime (x + z * y) y)) (mul_comm z y)) h)

theorem is_coprime.of_add_mul_left_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (h : is_coprime x (y + x * z)) : is_coprime x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x y)) (propext is_coprime_comm)))
    (is_coprime.of_add_mul_left_left
      (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (y + x * z))) (propext is_coprime_comm)) h))

theorem is_coprime.of_add_mul_right_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (h : is_coprime x (y + z * x)) : is_coprime x y :=
  is_coprime.of_add_mul_left_right
    (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (y + z * x))) (mul_comm z x)) h)

theorem is_coprime.of_mul_add_left_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (h : is_coprime (y * z + x) y) : is_coprime x y :=
  is_coprime.of_add_mul_left_left
    (eq.mp (Eq._oldrec (Eq.refl (is_coprime (y * z + x) y)) (add_comm (y * z) x)) h)

theorem is_coprime.of_mul_add_right_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (h : is_coprime (z * y + x) y) : is_coprime x y :=
  is_coprime.of_add_mul_right_left
    (eq.mp (Eq._oldrec (Eq.refl (is_coprime (z * y + x) y)) (add_comm (z * y) x)) h)

theorem is_coprime.of_mul_add_left_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (h : is_coprime x (x * z + y)) : is_coprime x y :=
  is_coprime.of_add_mul_left_right
    (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (x * z + y))) (add_comm (x * z) y)) h)

theorem is_coprime.of_mul_add_right_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R}
    (h : is_coprime x (z * x + y)) : is_coprime x y :=
  is_coprime.of_add_mul_right_right
    (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (z * x + y))) (add_comm (z * x) y)) h)

namespace is_coprime

theorem add_mul_left_left {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) :
    is_coprime (x + y * z) y :=
  sorry

theorem add_mul_right_left {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) :
    is_coprime (x + z * y) y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (x + z * y) y)) (mul_comm z y)))
    (add_mul_left_left h z)

theorem add_mul_left_right {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) :
    is_coprime x (y + x * z) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (y + x * z))) (propext is_coprime_comm)))
    (add_mul_left_left (symm h) z)

theorem add_mul_right_right {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y)
    (z : R) : is_coprime x (y + z * x) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (y + z * x))) (propext is_coprime_comm)))
    (add_mul_right_left (symm h) z)

theorem mul_add_left_left {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) :
    is_coprime (y * z + x) y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (y * z + x) y)) (add_comm (y * z) x)))
    (add_mul_left_left h z)

theorem mul_add_right_left {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) :
    is_coprime (z * y + x) y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (z * y + x) y)) (add_comm (z * y) x)))
    (add_mul_right_left h z)

theorem mul_add_left_right {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) :
    is_coprime x (x * z + y) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (x * z + y))) (add_comm (x * z) y)))
    (add_mul_left_right h z)

theorem mul_add_right_right {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y)
    (z : R) : is_coprime x (z * x + y) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (z * x + y))) (add_comm (z * x) y)))
    (add_mul_right_right h z)

theorem add_mul_left_left_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} :
    is_coprime (x + y * z) y ↔ is_coprime x y :=
  { mp := of_add_mul_left_left, mpr := fun (h : is_coprime x y) => add_mul_left_left h z }

theorem add_mul_right_left_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} :
    is_coprime (x + z * y) y ↔ is_coprime x y :=
  { mp := of_add_mul_right_left, mpr := fun (h : is_coprime x y) => add_mul_right_left h z }

theorem add_mul_left_right_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} :
    is_coprime x (y + x * z) ↔ is_coprime x y :=
  { mp := of_add_mul_left_right, mpr := fun (h : is_coprime x y) => add_mul_left_right h z }

theorem add_mul_right_right_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} :
    is_coprime x (y + z * x) ↔ is_coprime x y :=
  { mp := of_add_mul_right_right, mpr := fun (h : is_coprime x y) => add_mul_right_right h z }

theorem mul_add_left_left_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} :
    is_coprime (y * z + x) y ↔ is_coprime x y :=
  { mp := of_mul_add_left_left, mpr := fun (h : is_coprime x y) => mul_add_left_left h z }

theorem mul_add_right_left_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} :
    is_coprime (z * y + x) y ↔ is_coprime x y :=
  { mp := of_mul_add_right_left, mpr := fun (h : is_coprime x y) => mul_add_right_left h z }

theorem mul_add_left_right_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} :
    is_coprime x (x * z + y) ↔ is_coprime x y :=
  { mp := of_mul_add_left_right, mpr := fun (h : is_coprime x y) => mul_add_left_right h z }

theorem mul_add_right_right_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} :
    is_coprime x (z * x + y) ↔ is_coprime x y :=
  { mp := of_mul_add_right_right, mpr := fun (h : is_coprime x y) => mul_add_right_right h z }

end Mathlib


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Patrick Massot, Scott Morrison
-/
import category_theory.monad.limits
import topology.uniform_space.completion
import topology.category.Top.basic

/-!
# The category of uniform spaces

We construct the category of uniform spaces, show that the complete separated uniform spaces
form a reflective subcategory, and hence possess all limits that uniform spaces do.

TODO: show that uniform spaces actually have all limits!
-/

universes u

open category_theory

/-- A (bundled) uniform space. -/
def UniformSpace : Type (u+1) := bundled uniform_space

namespace UniformSpace

/-- The information required to build morphisms for `UniformSpace`. -/
instance : unbundled_hom @uniform_continuous :=
⟨@uniform_continuous_id, @uniform_continuous.comp⟩

attribute [derive [has_coe_to_sort, large_category, concrete_category]] UniformSpace

instance (x : UniformSpace) : uniform_space x := x.str

/-- Construct a bundled `UniformSpace` from the underlying type and the typeclass. -/
def of (α : Type u) [uniform_space α] : UniformSpace := ⟨α⟩

instance : inhabited UniformSpace := ⟨UniformSpace.of empty⟩

@[simp] lemma coe_of (X : Type u) [uniform_space X] : (of X : Type u) = X := rfl

instance (X Y : UniformSpace) : has_coe_to_fun (X ⟶ Y) :=
{ F := λ _, X → Y, coe := category_theory.functor.map (forget UniformSpace) }

@[simp] lemma coe_comp {X Y Z : UniformSpace} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g : X → Z) = g ∘ f := rfl
@[simp] lemma coe_id (X : UniformSpace) : (𝟙 X : X → X) = id := rfl
@[simp] lemma coe_mk {X Y : UniformSpace} (f : X → Y) (hf : uniform_continuous f) :
  ((⟨f, hf⟩ : X ⟶ Y) : X → Y) = f := rfl

lemma hom_ext {X Y : UniformSpace} {f g : X ⟶ Y} : (f : X → Y) = g → f = g := subtype.eq

/-- The forgetful functor from uniform spaces to topological spaces. -/
instance has_forget_to_Top : has_forget₂ UniformSpace.{u} Top.{u} :=
{ forget₂ :=
  { obj := λ X, Top.of X,
    map := λ X Y f, { to_fun := f,
                      continuous_to_fun := uniform_continuous.continuous f.property }, }, }

end UniformSpace

/-- A (bundled) complete separated uniform space. -/
structure CpltSepUniformSpace :=
(α : Type u)
[is_uniform_space : uniform_space α]
[is_complete_space : complete_space α]
[is_separated : separated_space α]

namespace CpltSepUniformSpace

instance : has_coe_to_sort CpltSepUniformSpace :=
{ S := Type u, coe := CpltSepUniformSpace.α }

attribute [instance] is_uniform_space is_complete_space is_separated

def to_UniformSpace (X : CpltSepUniformSpace) : UniformSpace :=
UniformSpace.of X

instance complete_space (X : CpltSepUniformSpace) : complete_space ((to_UniformSpace X).α) :=
CpltSepUniformSpace.is_complete_space X

instance separated_space (X : CpltSepUniformSpace) : separated_space ((to_UniformSpace X).α) :=
CpltSepUniformSpace.is_separated X

/-- Construct a bundled `UniformSpace` from the underlying type and the appropriate typeclasses. -/
def of (X : Type u) [uniform_space X] [complete_space X] [separated_space X] :
CpltSepUniformSpace := ⟨X⟩

@[simp] lemma coe_of (X : Type u) [uniform_space X] [complete_space X] [separated_space X] :
  (of X : Type u) = X := rfl

instance : inhabited CpltSepUniformSpace :=
begin
  haveI : separated_space empty := separated_iff_t2.mpr (by apply_instance),
  exact ⟨CpltSepUniformSpace.of empty⟩
end

/-- The category instance on `CpltSepUniformSpace`. -/
instance category : large_category CpltSepUniformSpace :=
induced_category.category to_UniformSpace

/-- The concrete category instance on `CpltSepUniformSpace`. -/
instance concrete_category : concrete_category CpltSepUniformSpace :=
induced_category.concrete_category to_UniformSpace

instance has_forget_to_UniformSpace : has_forget₂ CpltSepUniformSpace UniformSpace :=
induced_category.has_forget₂ to_UniformSpace

end CpltSepUniformSpace

namespace UniformSpace

open uniform_space
open CpltSepUniformSpace

/-- The functor turning uniform spaces into complete separated uniform spaces. -/
noncomputable def completion_functor : UniformSpace ⥤ CpltSepUniformSpace :=
{ obj := λ X, CpltSepUniformSpace.of (completion X),
  map := λ X Y f, ⟨completion.map f.1, completion.uniform_continuous_map⟩,
  map_id' := λ X, subtype.eq completion.map_id,
  map_comp' := λ X Y Z f g, subtype.eq (completion.map_comp g.property f.property).symm, }.

/-- The inclusion of a uniform space into its completion. -/
def completion_hom (X : UniformSpace) :
  X ⟶ (forget₂ CpltSepUniformSpace UniformSpace).obj (completion_functor.obj X) :=
{ val := (coe : X → completion X),
  property := completion.uniform_continuous_coe X }

@[simp] lemma completion_hom_val (X : UniformSpace) (x) :
  (completion_hom X) x = (x : completion X) := rfl

/-- The mate of a morphism from a `UniformSpace` to a `CpltSepUniformSpace`. -/
noncomputable def extension_hom {X : UniformSpace} {Y : CpltSepUniformSpace}
  (f : X ⟶ (forget₂ CpltSepUniformSpace UniformSpace).obj Y) :
  completion_functor.obj X ⟶ Y :=
{ val := completion.extension f,
  property := completion.uniform_continuous_extension }

@[simp] lemma extension_hom_val {X : UniformSpace} {Y : CpltSepUniformSpace}
  (f : X ⟶ (forget₂ _ _).obj Y) (x) :
  (extension_hom f) x = completion.extension f x := rfl.

@[simp]

/-- The completion functor is left adjoint to the forgetful functor. -/
noncomputable def adj : completion_functor ⊣ forget₂ CpltSepUniformSpace UniformSpace :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y,
  { to_fun := λ f, completion_hom X ≫ f,
    inv_fun := λ f, extension_hom f,
    left_inv := λ f, by { dsimp, erw extension_comp_coe },
    right_inv := λ f,
    begin
      apply subtype.eq, funext x, cases f,
      exact @completion.extension_coe _ _ _ _ _ (CpltSepUniformSpace.separated_space _) f_property _
    end },
  hom_equiv_naturality_left_symm' := λ X X' Y f g,
  begin
    apply hom_ext, funext x, dsimp,
    erw [coe_comp, ←completion.extension_map],
    refl, exact g.property, exact f.property,
  end }

noncomputable instance : is_right_adjoint (forget₂ CpltSepUniformSpace UniformSpace) :=
⟨completion_functor, adj⟩
noncomputable instance : reflective (forget₂ CpltSepUniformSpace UniformSpace) := {}

open category_theory.limits

-- TODO Once someone defines `has_limits UniformSpace`, turn this into an instance.
example [has_limits.{u} UniformSpace.{u}] : has_limits.{u} CpltSepUniformSpace.{u} :=
has_limits_of_reflective $ forget₂ CpltSepUniformSpace UniformSpace.{u}

end UniformSpace


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

/-!
# The Kleisli construction on the Type category

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

Define the Kleisli category for (control) monads.
`category_theory/monad/kleisli` defines the general version for a monad on `C`, and demonstrates
the equivalence between the two.

## TODO

Generalise this to work with category_theory.monad
-/

universes u v

namespace category_theory

/-- The Kleisli category on the (type-)monad `m`. Note that the monad is not assumed to be lawful
yet. -/
@[nolint unused_arguments]
def Kleisli (m : Type u → Type v) := Type u

/-- Construct an object of the Kleisli category from a type. -/
def Kleisli.mk (m) (α : Type u) : Kleisli m := α

instance Kleisli.category_struct {m} [monad.{u v} m] : category_struct (Kleisli m) :=
{ hom := λ α β, α → m β,
  id := λ α x, pure x,
  comp := λ X Y Z f g, f >=> g }

instance Kleisli.category {m} [monad.{u v} m] [is_lawful_monad m] : category (Kleisli m) :=
by refine { id_comp' := _, comp_id' := _, assoc' := _ };
   intros; ext; unfold_projs; simp only [(>=>)] with functor_norm

@[simp] lemma Kleisli.id_def {m} [monad m] (α : Kleisli m) :
  𝟙 α = @pure m _ α := rfl

lemma Kleisli.comp_def {m} [monad m] (α β γ : Kleisli m)
  (xs : α ⟶ β) (ys : β ⟶ γ) (a : α) :
  (xs ≫ ys) a = xs a >>= ys := rfl

instance : inhabited (Kleisli id) := ⟨punit⟩
instance {α : Type u} [inhabited α] : inhabited (Kleisli.mk id α) := ⟨show α, from default⟩
end category_theory


import measure_theory.integral.interval_integral
import order.filter.at_top_bot
import measure_theory.integral.integral_eq_improper

open measure_theory filter set topological_space
open_locale ennreal nnreal topological_space

namespace measure_theory

section ae_cover

variables {α ι : Type*} [measurable_space α] (μ : measure α) (l : filter ι)

variables {μ} {l}

section preorder_α

variables [linear_order α] [topological_space α] [order_closed_topology α]
  [opens_measurable_space α] [has_no_atoms μ] {a b : ι → α} {A B : α} (hab : A ≤ B)

lemma eventually_le_nhds
(a b : α) (hab : a < b)
:
∀ᶠ (x : α) in (nhds a), x ≤ b :=
begin
  rw eventually_iff,
  have : {x : α | x ≤ b} = Iic b, ext, simp,
  rw this,
  rw mem_nhds_iff,
  use Iio b,
  exact ⟨Iio_subset_Iic_self, is_open_Iio, hab⟩,
end

lemma eventually_lt_nhds
(a b : α) (hab : a < b)
:
∀ᶠ (x : α) in (nhds a), x < b :=
begin
  rw eventually_iff,
  have : {x : α | x < b} = Iio b, ext, simp,
  rw this,
  rw mem_nhds_iff,
  use Iio b,
  exact ⟨rfl.subset, is_open_Iio, hab⟩,
end

lemma eventually_ge_nhds
(a b : α) (hab : b < a)
:
∀ᶠ (x : α) in (nhds a), b ≤ x :=
begin
  rw eventually_iff,
  have : {x : α | b ≤ x} = Ici b, ext, simp,
  rw this,
  rw mem_nhds_iff,
  use Ioi b,
  exact ⟨Ioi_subset_Ici_self, is_open_Ioi, hab⟩,
end

lemma eventually_gt_nhds
(a b : α) (hab : b < a)
:
∀ᶠ (x : α) in (nhds a), b < x :=
begin
  rw eventually_iff,
  have : {x : α | b < x} = Ioi b, ext, simp,
  rw this,
  rw mem_nhds_iff,
  use Ioi b,
  exact ⟨rfl.subset, is_open_Ioi, hab⟩,
end

/-! ### finite ae covers by finite intervals

TODO: Pull out the `of_Icc`'s into a `preorder` section since that's all that's required
-/

lemma ae_eq_restrict_aux
{s t : set α}
(hs : measurable_set s) (ht : measurable_set t)
(hst : s =ᵐ[μ] t)
{f : α → Prop} :
(∀ᵐ (x : α) ∂μ.restrict s, f x) → (∀ᵐ (x : α) ∂μ.restrict t, f x) :=
begin
  rw [ae_restrict_iff' hs, ae_restrict_iff' ht, ae_iff, ae_iff],
  simp only [not_forall, exists_prop],
  intros h,
  have aa : {a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ t ∧ ¬f a} = {a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ (t \ s) ∧ ¬f a},
  {
    ext,
    simp only [mem_union_eq, mem_set_of_eq, mem_diff],
    conv { congr, congr, rw and_comm, skip, rw and_comm, skip, congr, rw and_comm, skip, rw and_comm, },
    rw [←and_or_distrib_left, ←and_or_distrib_left, and.congr_right_iff],
    intros hf,
    rw [←mem_union, ←mem_diff, ←mem_union],
    conv { to_rhs, rw union_comm, rw diff_union_self, rw union_comm, },
  },
  have bb : {a : α | a ∈ t ∧ ¬f a} ⊆ {a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ t ∧ ¬f a}, simp,
  have cc : μ ({a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ t ∧ ¬f a}) = 0, {
    rw aa,
    have : μ ({a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ (t \ s) ∧ ¬f a}) ≤ μ {a : α | a ∈ s ∧ ¬f a} + μ {a : α | a ∈ (t \ s) ∧ ¬f a}, exact measure_union_le _ _,
    rw h at this,
    rw ae_eq_set at hst,
    have dd : {a : α | a ∈ (t \ s) ∧ ¬f a} ⊆ t \ s, rw subset_def, simp, intros x ht hs _, exact ⟨ht, hs⟩,
    rw measure_mono_null dd hst.right at this,
    rw zero_add at this,
    rw nonpos_iff_eq_zero at this,
    exact this,
  },
  exact measure_mono_null bb cc,
end

lemma ae_eq_restrict
{s t : set α}
(hs : measurable_set s) (ht : measurable_set t)
(hst : s =ᵐ[μ] t)
{f : α → Prop} :
(∀ᵐ (x : α) ∂μ.restrict s, f x) ↔ (∀ᵐ (x : α) ∂μ.restrict t, f x) :=
begin
  split,
  exact ae_eq_restrict_aux hs ht hst,
  exact ae_eq_restrict_aux ht hs hst.symm,
end

lemma ae_cover_restrict_of_ae_eq_aux
{φ : ι → set α}
{s t : set α}
(hs : measurable_set s)
(ht : measurable_set t)
(hst : s =ᵐ[μ] t)
(h : ae_cover (μ.restrict s) l φ) :
ae_cover (μ.restrict t) l φ := {
  ae_eventually_mem := begin
    rw ←ae_eq_restrict hs ht hst,
    exact h.ae_eventually_mem,
  end,
  measurable := h.measurable,
}

lemma ae_cover_restrict_of_ae_eq
{φ : ι → set α}
{s t : set α}
(hs : measurable_set s)
(ht : measurable_set t)
(hst : s =ᵐ[μ] t) :
ae_cover (μ.restrict s) l φ ↔ ae_cover (μ.restrict t) l φ :=
⟨ae_cover_restrict_of_ae_eq_aux hs ht hst, ae_cover_restrict_of_ae_eq_aux ht hs hst.symm⟩

lemma ae_cover_Ioo_of_Icc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioo A B) l (λ i, Icc (a i) (b i)) :=
{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
      ae_of_all μ (λ x hx,
      (ha.eventually $ eventually_le_nhds A x hx.left).mp $
      (hb.eventually $eventually_ge_nhds B x hx.right).mono $
      λ i hbi hai, ⟨hai, hbi⟩)),
  measurable := λ i, measurable_set_Icc, }

lemma ae_cover_Ioo_of_Ico (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioo A B) l (λ i, Ico (a i) (b i)) :=
{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
      ae_of_all μ (λ x hx,
      (ha.eventually $ eventually_le_nhds A x hx.left).mp $
      (hb.eventually $ eventually_gt_nhds B x hx.right).mono $
      λ i hbi hai, ⟨hai, hbi⟩)),
  measurable := λ i, measurable_set_Ico, }

lemma ae_cover_Ioo_of_Ioc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioo A B) l (λ i, Ioc (a i) (b i)) :=
{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
      ae_of_all μ (λ x hx,
      (ha.eventually $ eventually_lt_nhds A x hx.left).mp $
      (hb.eventually $ eventually_ge_nhds B x hx.right).mono $
      λ i hbi hai, ⟨hai, hbi⟩)),
  measurable := λ i, measurable_set_Ioc, }

lemma ae_cover_Ioo_of_Ioo (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioo A B) l (λ i, Ioo (a i) (b i)) :=
{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
      ae_of_all μ (λ x hx,
      (ha.eventually $ eventually_lt_nhds A x hx.left).mp $
      (hb.eventually $ eventually_gt_nhds B x hx.right).mono $
      λ i hbi hai, ⟨hai, hbi⟩)),
  measurable := λ i, measurable_set_Ioo, }

lemma ae_cover_Ioc_of_Icc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioc A B) l (λ i, Icc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ioc A B, exact Ioo_ae_eq_Ioc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ioc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Icc ha hb,
end

lemma ae_cover_Ioc_of_Ico (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioc A B) l (λ i, Ico (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ioc A B, exact Ioo_ae_eq_Ioc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ioc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ico ha hb,
end

lemma ae_cover_Ioc_of_Ioc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioc A B) l (λ i, Ioc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ioc A B, exact Ioo_ae_eq_Ioc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ioc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioc ha hb,
end

lemma ae_cover_Ioc_of_Ioo (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioc A B) l (λ i, Ioo (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ioc A B, exact Ioo_ae_eq_Ioc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ioc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioo ha hb,
end

lemma ae_cover_Ico_of_Icc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ico A B) l (λ i, Icc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ico A B, exact Ioo_ae_eq_Ico,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ico measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Icc ha hb,
end

lemma ae_cover_Ico_of_Ico (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ico A B) l (λ i, Ico (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ico A B, exact Ioo_ae_eq_Ico,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ico measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ico ha hb,
end

lemma ae_cover_Ico_of_Ioc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ico A B) l (λ i, Ioc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ico A B, exact Ioo_ae_eq_Ico,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ico measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioc ha hb,
end

lemma ae_cover_Ico_of_Ioo (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ico A B) l (λ i, Ioo (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ico A B, exact Ioo_ae_eq_Ico,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ico measurable_set_Ioo  this.symm),
  exact ae_cover_Ioo_of_Ioo ha hb,
end

lemma ae_cover_Icc_of_Icc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Icc A B) l (λ i, Icc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Icc A B, exact Ioo_ae_eq_Icc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Icc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Icc ha hb,
end

lemma ae_cover_Icc_of_Ico (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Icc A B) l (λ i, Ico (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Icc A B, exact Ioo_ae_eq_Icc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Icc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ico ha hb,
end

lemma ae_cover_Icc_of_Ioc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Icc A B) l (λ i, Ioc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Icc A B, exact Ioo_ae_eq_Icc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Icc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioc ha hb,
end

lemma ae_cover_Icc_of_Ioo (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Icc A B) l (λ i, Ioo (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Icc A B, exact Ioo_ae_eq_Icc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Icc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioo ha hb,
end

end preorder_α
end ae_cover
end measure_theory