import formula
import proof

section basics

  variables {ι : Type} [decidable_eq ι] {gri : ground_interpretation ι}
  local notation `𝔽` := formula ι gri
  local notation `𝕋` := type ι gri
  variables {greq : Π {i : ι}, ∥𝕏 i // gri ∥ → ∥𝕏 i // gri ∥ → 𝔽}
  local infixr `≅` : 35 := formula.eqext @greq

  namespace formula

  def nn : 𝔽 → 𝔽
  | (@prime _ _ _ p decp) := @prime _ _ _ p decp
  | (A ⋀ B) := A.nn ⋀ B.nn
  | (A ⋁ B) := A.nn ⋁ B.nn
  | (A ⟹ B) := A.nn ⟹ B.nn
  | (universal' σ A) := ∀∀ (x : ∥σ∥), ∼∼(A x).nn
  | (existential' σ A) := ∃∃ (x : ∥σ∥), (A x).nn

  @[reducible, simp]
  def dnt (A : 𝔽) := ∼∼A.nn

  end formula

end basics

section soundness

  variables {ι : Type} [decidable_eq ι] {gri : ground_interpretation ι}
  local notation `𝔽` := formula ι gri
  local notation `𝕋` := type ι gri
  variables {greq : Π {i : ι}, ∥𝕏 i // gri ∥ → ∥𝕏 i // gri ∥ → 𝔽}
  local infixr `≅` : 35 := formula.eqext @greq

  def clsc : principles := {with_lem := tt, with_markov := ff, with_ip := ff, with_ac := ff}
  def intu : principles := {with_lem := ff, with_markov := tt, with_ip := ff, with_ac := ff}

  open proof formula

  local attribute [simp] nn

  #check and_contr

  example : Π (Γ) (A : 𝔽), (proof @greq intu Γ (A ⇔ A.dnt)) :=
  begin
    intros Γ A,
    induction A,
    case prime {
      simp,

    }
  end

  def dnt_sound (Γ : premises ι gri) : Π A : 𝔽,
    proof @greq clsc Γ A →
    proof @greq intu Γ A.dnt
  | _ (lem A _):=
  begin
    simp,
    dsimp [dnt] at dnt_sound,
  end

end soundness


import data.nat.choose ring_theory.multiplicity algebra.gcd_domain data.nat.modeq tactic.linarith
import data.zmod.basic data.nat.parity data.polynomial
open finset nat multiplicity

lemma not_even_iff {n : ℕ} : ¬ even n ↔ n % 2 = 1 :=
by rw [even_iff, mod_two_ne_zero]

lemma dvd_sum {α β : Type*} [comm_semiring α] {s : finset β}
  {f : β → α} {a : α} : (∀ x ∈ s, a ∣ f x) → a ∣ s.sum f :=
by classical; exact finset.induction_on s (by simp)
  (λ b s hbs ih h, by rw [sum_insert hbs];
     exact dvd_add (h b (by simp))
       (ih (λ x hx, h x (by finish))))

lemma pow_dvd_iff_le_card_pow_dvd {m n r : ℕ} (hm1 : 1 < m) (hn0 : 0 < n) : m ^ r ∣ n ↔
  r ≤ ((finset.Ico 1 n).filter (λ i, m ^ i ∣ n)).card :=
⟨λ h, calc r = (Ico 1 (r+1)).card : by simp
  ... ≤ _ : card_le_of_subset
    (begin
      assume x hx,
      simp only [Ico.mem, mem_filter] at *,
      exact ⟨⟨hx.1, lt_of_le_of_lt (le_of_lt_succ hx.2)
          (lt_of_lt_of_le (lt_pow_self hm1 _) (le_of_dvd hn0 h))⟩,
        dvd_trans (nat.pow_dvd_pow _ (le_of_lt_succ hx.2)) h⟩,
    end),
λ hr, by_contradiction $ λ h, not_lt_of_ge hr $
  calc ((finset.Ico 1 n).filter (λ i, m ^ i ∣ n)).card <
        (range r).card : card_lt_card
      ⟨begin
        assume x hx,
        simp only [mem_range, mem_filter] at *,
        exact lt_of_not_ge (λ hxr, h (dvd_trans (nat.pow_dvd_pow _ hxr) hx.2))
      end, λ hsub,
        have h0r : 0 < r, from nat.pos_of_ne_zero (λ hr0, by simp * at *),
        by simpa using hsub (mem_range.2 h0r)⟩
  ... = r : card_range _ ⟩

lemma card_pow_dvd_eq_multiplicity {m n : ℕ} (hm1 : 1 < m) (hn0 : 0 < n) :
  ↑((finset.Ico 1 n).filter (λ i, m ^ i ∣ n)).card = multiplicity m n :=
multiplicity.unique
  (by rw [nat.pow_eq_pow, pow_dvd_iff_le_card_pow_dvd hm1 hn0])
  (by rw [nat.pow_eq_pow, pow_dvd_iff_le_card_pow_dvd hm1 hn0]; simp)

lemma sum_Ico_succ_top {α : Type*} [add_comm_monoid α] {a b : ℕ} (hab : a ≤ b) (f : ℕ → α) :
  (Ico a (b + 1)).sum f = (Ico a b).sum f + f b :=
by rw [Ico.succ_top hab, sum_insert Ico.not_mem_top, add_comm]

lemma Ico_succ_bot {a b : ℕ} (hab : a < b) : insert a (Ico (succ a) b) = Ico a b :=
begin
  simp only [finset.ext, succ_le_iff, mem_insert, Ico.mem, hab],
  assume i,
  split,
  { rintro ⟨rfl | h, hab⟩,
    { simp * },
    { exact ⟨le_of_lt a_1.1, a_1.2⟩ } },
  { rintros ⟨hai, hab⟩,
    rcases lt_or_eq_of_le hai with hai | rfl,
    { simp * },
    { simp * } }
end

lemma sum_eq_sum_Ico_succ_bot {α : Type*} [add_comm_monoid α] {a b : ℕ} (hab : a < b)
  (f : ℕ → α) : (Ico a b).sum f = f a + (Ico (a + 1) b).sum f :=
have ha : a ∉ Ico (a + 1) b, by simp,
by rw [← sum_insert ha, Ico_succ_bot hab]

lemma nat.prime.multiplicity_one {p : ℕ} (hp : p.prime) :
  multiplicity p 1 = 0 :=
by rw [multiplicity.one_right (mt is_unit_nat.mp (ne_of_gt hp.one_lt))]

lemma nat.prime.multiplicity_mul {p m n : ℕ} (hp : p.prime) :
  multiplicity p (m * n) = multiplicity p m + multiplicity p n :=
by rw [int.coe_nat_multiplicity, int.coe_nat_multiplicity,
  int.coe_nat_multiplicity, int.coe_nat_mul, multiplicity.mul (nat.prime_iff_prime_int.1 hp)]

lemma nat.prime.multiplicity_pow {p m n : ℕ} (hp : p.prime) :
  multiplicity p (m ^ n) = add_monoid.smul n (multiplicity p m) :=
by induction n; simp [nat.pow_succ, hp.multiplicity_mul, *, hp.multiplicity_one, succ_smul]

lemma nat.prime.multiplicity_self {p : ℕ} (hp : p.prime) : multiplicity p p = 1 :=
have h₁ : ¬ is_unit (p : ℤ), from mt is_unit_int.1 (ne_of_gt hp.one_lt),
have h₂ : (p : ℤ) ≠ 0, from int.coe_nat_ne_zero.2 hp.ne_zero,
by rw [int.coe_nat_multiplicity, multiplicity_self h₁ h₂]

lemma nat.prime.multiplicity_pow_self {p n : ℕ} (hp : p.prime) : multiplicity p (p ^ n) = n :=
by induction n; simp [hp.multiplicity_one, nat.pow_succ, hp.multiplicity_mul, *,
  hp.multiplicity_self, succ_eq_add_one]

lemma nat.prime.pow_dvd_fact {p : ℕ} : ∀ {n r : ℕ} (hp : p.prime),
   p ^ r ∣ fact n ↔ r ≤ (Ico 1 (n+1)).sum (λ i, n / p ^ i)
| 0     0     hp := by simp
| 0     (r+1) hp := by simp [nat.pow_succ, nat.mul_eq_one_iff, ne_of_gt hp.one_lt]
| (n+1) r     hp :=
have (Ico 1 (n+1)).sum (λ i, (n + 1) / p ^ i) =
  (Ico 1 (n+1)).sum (λ i, n / p ^ i)
    + ((Ico 1 (n+1)).filter (λ i, p^i ∣ (n+1))).card,
  from calc (Ico 1 (n+1)).sum (λ i, (n + 1) / p ^ i)
      = (Ico 1 (n+1)).sum (λ i, n / p ^ i + ite (p^i ∣ (n+1)) 1 0) :
    sum_congr rfl $ λ _ _, by rw nat.succ_div; exact nat.pow_pos hp.pos _
  ... = _ : by rw [sum_add_distrib, sum_ite (λ _, 1) (λ _, 0) (λ x, x)]; simp,
have hnp : (n + 1) / p ^ (n + 1) = 0,
  from (nat.div_eq_zero_iff (nat.pow_pos hp.pos _)).2 (lt_pow_self hp.one_lt _),
begin
  rw [sum_Ico_succ_top (nat.succ_pos _), hnp, this],
  by_cases hr : r ≤  ((Ico 1 (n+1)).filter (λ i, p ^ i ∣ (n + 1))).card,
  { exact iff_of_true
      (dvd_mul_of_dvd_left ((pow_dvd_iff_le_card_pow_dvd hp.one_lt (succ_pos _)).2 hr) _)
      (le_trans hr (le_add_left _ _)) },
  { erw [← @nat.sub_le_right_iff_le_add _ _ (card _), ← hp.pow_dvd_fact],
    conv_rhs { rw [← nat.mul_dvd_mul_iff_left
      (nat.pow_pos hp.pos (((Ico 1 (n+1)).filter (λ i, p^i ∣ (n+1))).card))] },
    split,
    { assume h,
      refine mul_dvd_mul (dvd_refl _) _,
      rw [pow_dvd_iff_le_card_pow_dvd hp.one_lt (fact_pos _), nat.sub_le_right_iff_le_add],
      rw [pow_dvd_iff_le_card_pow_dvd hp.one_lt (fact_pos _)] at h,
      refine le_trans h _,
      rw [← enat.coe_le_coe, enat.coe_add, card_pow_dvd_eq_multiplicity hp.one_lt (fact_pos _),
        card_pow_dvd_eq_multiplicity hp.one_lt (fact_pos _),
        card_pow_dvd_eq_multiplicity hp.one_lt (succ_pos _),
        ← hp.multiplicity_mul, fact_succ, mul_comm] },
    { rw [← nat.pow_add, nat.add_sub_cancel' (le_of_not_le hr)],
      exact function.swap dvd_trans
        (by rw [fact_succ]; exact (nat.mul_dvd_mul_iff_right (fact_pos _)).2
          ((pow_dvd_iff_le_card_pow_dvd hp.one_lt (succ_pos _)).2 (le_refl _))) } },
end

lemma multiplicity_fact {p n : ℕ} (hp : p.prime) :
  multiplicity p (fact n) = ((Ico 1 (n+1)).sum (λ i, n / p ^ i) : ℕ) :=
eq.symm $ multiplicity.unique
  (by rw [nat.pow_eq_pow, hp.pow_dvd_fact])
  (by rw [nat.pow_eq_pow, hp.pow_dvd_fact]; simp)

lemma whatever {p n k : ℕ} (hkn : k ≤ n) (hp : p.prime) :
  multiplicity p (choose n k) + multiplicity p (fact k) + multiplicity p (fact (n - k)) =
  multiplicity p (fact n) :=
by rw [← hp.multiplicity_mul, ← hp.multiplicity_mul, choose_mul_fact_mul_fact hkn]

lemma mod_add_le_mod_add (a b c : ℕ) : (a + b) % c ≤ a % c + b % c :=
if hc0 : c = 0 then by simp [hc0]
else by_contradiction $ λ h, begin
  have := mod_eq_of_lt (lt_trans (lt_of_not_ge h)
    (mod_lt _ (nat.pos_of_ne_zero hc0))),
  rw ← this at h,
  exact h (le_of_eq (nat.modeq.modeq_add (nat.modeq.mod_modeq _ _).symm
    (nat.modeq.mod_modeq _ _).symm))
end

lemma add_div_le_add_div (a b c : ℕ) : a / c + b / c ≤ (a + b) / c :=
if hc0 : c = 0 then by simp [hc0]
else begin
  refine le_of_mul_le_mul_left _ (nat.pos_of_ne_zero hc0),
  refine @nat.le_of_add_le_add_left (a % c + b % c) _ _ _,
  rw [mul_add, add_add_add_comm, mod_add_div, mod_add_div],
  conv_lhs { rw ← mod_add_div (a + b) c },
  exact add_le_add_right (mod_add_le_mod_add _ _ _) _
end

lemma add_div_add_ite_le_add_div (a b c : ℕ) (hc0 : 0 < c):
  a / c + b / c + (if c ∣ a + b ∧ ¬ c ∣ a then 1 else 0) ≤ (a + b) / c :=
if h : c ∣ a + b ∧ ¬ c ∣ a
then
have a % c + b % c = c,
  from have c ∣ a % c + b % c,
    from dvd_of_mod_eq_zero $ by rw [← mod_eq_zero_of_dvd h.1];
      exact nat.modeq.modeq_add (nat.modeq.mod_modeq _ _) (nat.modeq.mod_modeq _ _),
  let ⟨x, hx⟩ := this in
  have a % c + b % c < c * 2,
    by rw [mul_two]; exact add_lt_add (mod_lt _ hc0) (mod_lt _ hc0),
  have hx2 : x < 2, from lt_of_mul_lt_mul_left (by rwa [← hx]) (le_of_lt hc0),
  have hx1 : x = 1, from le_antisymm (le_of_lt_succ hx2)
    (nat.pos_of_ne_zero
      (λ hx0, by clear_aux_decl; simp [*, lt_irrefl, nat.dvd_iff_mod_eq_zero] at *)),
  by simp * at *,
begin
  rw [if_pos h],
  refine le_of_mul_le_mul_left _ hc0,
  refine @le_of_add_le_add_left _ _ (a % c + b % c) _ _ _,
  rw [mul_add, mul_add, mul_one, ← add_assoc, add_add_add_comm, mod_add_div,
    mod_add_div, nat.mul_div_cancel' h.1, this, add_comm]
end
else by rw [if_neg h, add_zero]; exact add_div_le_add_div _ _ _

lemma multiplicity_choose_aux {p n k : ℕ} (hp : p.prime) (hk0 : 0 < k) (hkn : k < n) (hn0 : 0 < n) :
  (Ico 1 (k+1)).sum (λ i, k / p ^ i)
  + (Ico 1 ((n-k) + 1)).sum (λ i, (n - k) / p ^ i)
  + ((finset.Ico 1 n).filter (λ i, p ^ i ∣ n)).card
  ≤ (Ico 1 (n+1)).sum (λ i, n / p ^ i)
  + ((finset.Ico 1 k).filter (λ i, p ^ i ∣ k)).card :=
have h₁ : ∀ k ≤ n, 0 < k → (Ico 1 (k+1)).sum (λ i, k / p ^ i) = (Ico 1 (n+1)).sum (λ i, k / p ^ i),
  from λ k hk hk0, sum_subset ((Ico.subset_iff (succ_lt_succ hk0)).2 ⟨le_refl _, succ_le_succ hk⟩)
    (λ i hin hik, (nat.div_eq_zero_iff (nat.pow_pos hp.pos _)).2 $
      lt_of_lt_of_le (lt_pow_self hp.one_lt _) (le_of_dvd (nat.pow_pos hp.pos _)
        (pow_dvd_pow _ (le_of_lt $ by simp [*, succ_le_iff] at *)))),
have h₂ : ∀ k ≤ n, 0 < k → (finset.Ico 1 k).filter (λ i, p ^ i ∣ k) =
    (finset.Ico 1 (n + 1)).filter (λ i, p ^ i ∣ k),
  from λ k hkn hk0, le_antisymm
    (filter_subset_filter (Ico.subset (le_refl _) (le_trans hkn (le_succ _))))
    (λ x, begin
      simp only [mem_filter, Ico.mem, nat.succ_le_iff, and_imp, true_and, and_true] { contextual := tt },
      assume hx0 hxn hpxk,
      exact lt_of_lt_of_le (nat.lt_pow_self hp.one_lt _) (le_of_dvd hk0 hpxk)
    end),
begin
  rw [h₁ _ (le_of_lt hkn) hk0, h₁ _ (nat.sub_le_self n k) (nat.sub_pos_of_lt hkn),
    h₂ k (le_of_lt hkn) hk0, h₂ n (le_refl _) hn0,
    ← mul_one (card _), ← nat.smul_eq_mul, ← sum_const, sum_filter,
    ← mul_one (card _), ← nat.smul_eq_mul, ← sum_const, sum_filter,
    ← sum_add_distrib, ← sum_add_distrib, ← sum_add_distrib],
  refine finset.sum_le_sum (λ i hi, _),
  have := add_div_add_ite_le_add_div k (n - k) (p ^ i) (nat.pow_pos hp.pos _),
  rw [nat.add_sub_cancel' (le_of_lt hkn)] at this,
  split_ifs at *; simp * at *; linarith
end

lemma le_multiplicity_choose {p n k : ℕ} (hp : p.prime) (hn0 : 0 < n) (hk0 : 0 < k)
  (hkn : k < n) : multiplicity p n ≤ multiplicity p (choose n k) + multiplicity p k :=
have h₁ : multiplicity p (fact k) + multiplicity p (fact (n - k)) + multiplicity p n
  ≤ multiplicity p (fact n) + multiplicity p k,
  begin
    rw [multiplicity_fact hp, multiplicity_fact hp, multiplicity_fact hp,
      ← card_pow_dvd_eq_multiplicity hp.one_lt hn0,
      ← card_pow_dvd_eq_multiplicity hp.one_lt hk0,
      ← enat.coe_add, ← enat.coe_add, ← enat.coe_add, enat.coe_le_coe],
    exact multiplicity_choose_aux hp hk0 hkn hn0
  end,
have h₂ : ((multiplicity p n).get (finite_nat_iff.2 ⟨ne_of_gt hp.one_lt, hn0⟩) : enat) ≤
    (multiplicity p (choose n k * k)).get (finite_nat_iff.2 ⟨ne_of_gt hp.one_lt,
      mul_pos (choose_pos (le_of_lt hkn)) hk0⟩),
  from enat.coe_le_coe.2 (@le_of_add_le_add_right _ _ _
    ((multiplicity p (fact k * fact (n - k))).get
      (finite_nat_iff.2 ⟨ne_of_gt hp.one_lt, mul_pos (fact_pos _) (fact_pos _)⟩))
    _ begin
      rw [← enat.coe_le_coe],
      simp only [enat.coe_add, enat.coe_get],
      rw [← hp.multiplicity_mul, ← hp.multiplicity_mul, mul_comm _ k,
        mul_assoc k, ← mul_assoc (nat.choose _ _), choose_mul_fact_mul_fact (le_of_lt hkn)],
      simpa [hp.multiplicity_mul] using h₁
    end),
by rwa [enat.coe_get, enat.coe_get, hp.multiplicity_mul] at h₂

lemma nat.prime.pow_dvd_choose_mul_pow {p n k r j : ℕ} (hp : p.prime) (hk0 : 0 < k)
  (hpn : p ^ r ∣ n) (hpjk : ¬ p ^ (j + 1) ∣ k) :
  p ^ r ∣ choose n k * p ^ j :=
if hn0 : n = 0 then by cases k; simp [hn0, choose_zero_succ, lt_irrefl, *] at *
else if hk_eq_n : k = n
then begin
  subst hk_eq_n,
  simp,
  refine nat.pow_dvd_pow _ (le_of_not_gt
    (λ hrj, hpjk (dvd_trans (nat.pow_dvd_pow _ (succ_le_of_lt hrj)) hpn))),
end
else if hn_lt_k : n < k
then by simp [choose_eq_zero_of_lt hn_lt_k]
else have multiplicity p n ≤ multiplicity p (choose n k * p ^ j),
  from calc multiplicity p n ≤ multiplicity p (choose n k) + multiplicity p k :
      le_multiplicity_choose hp (nat.pos_of_ne_zero hn0) hk0 (lt_of_le_of_ne (le_of_not_gt hn_lt_k) hk_eq_n)
    ... ≤ multiplicity p (choose n k) + j :
      add_le_add' (le_refl _) (enat.le_of_lt_add_one
        (by rw [← enat.coe_one, ← enat.coe_add]; rw [← nat.pow_eq_pow] at hpjk;
          exact multiplicity_lt_iff_neg_dvd.2 hpjk))
    ... = _ : by rw [← hp.multiplicity_pow_self, hp.multiplicity_mul],
  begin
    rw [multiplicity_le_multiplicity_iff] at this,
    simp only [nat.pow_eq_pow] at *,
    exact this r hpn
  end

lemma nat.prime.pow_dvd_choose_mul {p n k r : ℕ} (hp : p.prime) (hk0 : 0 < k) (hkn : k < n)
  (hpn : p ^ r ∣ n) :  p ^ r ∣ choose n k * k :=
if hn0 : n = 0 then by cases k; simp [hn0, choose_zero_succ, lt_irrefl, *] at *
else
begin
  have := le_multiplicity_choose hp (nat.pos_of_ne_zero hn0) hk0 hkn,
  rw [← hp.multiplicity_mul, multiplicity_le_multiplicity_iff] at this,
  simp only [nat.pow_eq_pow] at this,
  exact this r hpn
end

lemma zmod.is_unit_iff_coprime (n : ℕ+) (a : ℕ) :
  is_unit (a : zmod n) ↔ coprime a n :=
have hc : coprime a n ↔ coprime (a : zmod n).val n,
  by rw [zmod.val_cast_nat, coprime, coprime, ← gcd_rec, nat.gcd_comm],
⟨λ ⟨u, hu⟩, begin
  have : coprime (u : zmod n).val n:= (@zmod.units_equiv_coprime n u).2,
  rwa [← hu, ← hc] at this,
end, λ h, ⟨(@zmod.units_equiv_coprime n).symm ⟨a, hc.1 h⟩, rfl⟩⟩

lemma nat.prime.pow_dvd_of_dvd_mul_of_not_dvd {p r m n : ℕ} (hp : p.prime) (hdvd : p ^ r ∣ m * n)
  (hpn : ¬p ∣ n) : p ^ r ∣ m :=
begin
  induction r with r ih,
  { simp },
  { cases ih (dvd_trans ⟨p, nat.pow_succ _ _⟩ hdvd) with a ha,
    rw [ha, mul_assoc, nat.pow_succ, nat.mul_dvd_mul_iff_left (nat.pow_pos hp.pos _),
      hp.dvd_mul] at hdvd,
    rw [ha, nat.pow_succ, nat.mul_dvd_mul_iff_left (nat.pow_pos hp.pos _)],
    tauto }
end

lemma dvd_of_forall_prime_pow_dvd : ∀ {m n : ℕ} (h : ∀ (p r : ℕ), p.prime → p ^ r ∣ m → p ^ r ∣ n), m ∣ n
| 0     n h :=
  by_contradiction (λ hn0,
    have hn0 : 0 < n, from nat.pos_of_ne_zero (mt zero_dvd_iff.2 hn0),
    not_le_of_gt (lt_pow_self (show 1 < 2, from dec_trivial) n) (le_of_dvd hn0 (h _ _ prime_two (dvd_zero _))))
| 1     n h := one_dvd _
| (m+2) n h :=
let p := min_fac (m+2) in
have hp : p.prime, from min_fac_prime dec_trivial,
have wf : (m + 2) / p < m + 2, from factors_lemma,
have hpn : p ∣ n, by rw [← nat.pow_one p]; exact h _ _ hp (by convert min_fac_dvd _; simp),
have (m + 2) / p ∣ n / p, from dvd_of_forall_prime_pow_dvd
  (λ q r hq (hdvd : q ^ r ∣ (m + 2) / p), show q ^ r ∣ n / p,
    from if hpq : p = q then begin
      subst hpq,
      have : p ^ (r + 1) ∣ n, from h p (r+1) hp
        (by rw [← nat.div_mul_cancel (min_fac_dvd (m+2)), nat.pow_succ];
          exact mul_dvd_mul hdvd (dvd_refl _)),
      have hpn : p ∣ n, from dvd_trans (by simp [nat.pow_succ]) this,
      rwa [← nat.mul_dvd_mul_iff_left hp.pos, nat.mul_div_cancel' hpn, mul_comm, ← nat.pow_succ],
    end
    else begin
      have := h q r hq (dvd_trans hdvd (div_dvd_of_dvd (min_fac_dvd _))),
      rw [← nat.div_mul_cancel hpn] at this,
      refine hq.pow_dvd_of_dvd_mul_of_not_dvd this _,
      simp [nat.dvd_prime hp, ne.symm hpq, ne_of_gt hq.one_lt],
    end),
by rw [← nat.mul_div_cancel' hpn, ← nat.mul_div_cancel' (min_fac_dvd (m + 2))];
  exact mul_dvd_mul (dvd_refl _) this


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Robert Y. Lewis, Gabriel Ebner
-/
import data.bool
import meta.rb_map
import tactic.lint.basic

/-!
# Linters about type classes

This file defines several linters checking the correct usage of type classes
and the appropriate definition of instances:

 * `instance_priority` ensures that blanket instances have low priority.
 * `has_inhabited_instances` checks that every type has an `inhabited` instance.
 * `impossible_instance` checks that there are no instances which can never apply.
 * `incorrect_type_class_argument` checks that only type classes are used in
   instance-implicit arguments.
 * `dangerous_instance` checks for instances that generate subproblems with metavariables.
 * `fails_quickly` checks that type class resolution finishes quickly.
 * `class_structure` checks that every `class` is a structure, i.e. `@[class] def` is forbidden.
 * `has_coe_variable` checks that there is no instance of type `has_coe α t`.
 * `inhabited_nonempty` checks whether `[inhabited α]` arguments could be generalized
   to `[nonempty α]`.
 * `decidable_classical` checks propositions for `[decidable_... p]` hypotheses that are not used
   in the statement, and could thus be removed by using `classical` in the proof.
 * `linter.has_coe_to_fun` checks whether necessary `has_coe_to_fun` instances are declared.
 * `linter.check_reducibility` checks whether non-instances with a class as type are reducible.
-/

open tactic

/-- Pretty prints a list of arguments of a declaration. Assumes `l` is a list of argument positions
and binders (or any other element that can be pretty printed).
`l` can be obtained e.g. by applying `list.indexes_values` to a list obtained by
`get_pi_binders`. -/
meta def print_arguments {α} [has_to_tactic_format α] (l : list (ℕ × α)) : tactic string := do
  fs ← l.mmap (λ ⟨n, b⟩, (λ s, to_fmt "argument " ++ to_fmt (n+1) ++ ": " ++ s) <$> pp b),
  return $ fs.to_string_aux tt

/-- checks whether an instance that always applies has priority ≥ 1000. -/
private meta def instance_priority (d : declaration) : tactic (option string) := do
  let nm := d.to_name,
  b ← is_instance nm,
  /- return `none` if `d` is not an instance -/
  if ¬ b then return none else do
  (is_persistent, prio) ← has_attribute `instance nm,
  /- return `none` if `d` is has low priority -/
  if prio < 1000 then return none else do
  (_, tp) ← open_pis d.type,
  tp ← whnf tp transparency.none,
  let (fn, args) := tp.get_app_fn_args,
  cls ← get_decl fn.const_name,
  let (pi_args, _) := cls.type.pi_binders,
  guard (args.length = pi_args.length),
  /- List all the arguments of the class that block type-class inference from firing
    (if they are metavariables). These are all the arguments except instance-arguments and
    out-params. -/
  let relevant_args := (args.zip pi_args).filter_map $ λ⟨e, ⟨_, info, tp⟩⟩,
    if info = binder_info.inst_implicit ∨ tp.get_app_fn.is_constant_of `out_param
    then none else some e,
  let always_applies := relevant_args.all expr.is_local_constant ∧ relevant_args.nodup,
  if always_applies then return $ some "set priority below 1000" else return none

/--
There are places where typeclass arguments are specified with implicit `{}` brackets instead of
the usual `[]` brackets. This is done when the instances can be inferred because they are implicit
arguments to the type of one of the other arguments. When they can be inferred from these other
arguments,  it is faster to use this method than to use type class inference.

For example, when writing lemmas about `(f : α →+* β)`, it is faster to specify the fact that `α`
and `β` are `semiring`s as `{rα : semiring α} {rβ : semiring β}` rather than the usual
`[semiring α] [semiring β]`.
-/
library_note "implicit instance arguments"

/--
Certain instances always apply during type-class resolution. For example, the instance
`add_comm_group.to_add_group {α} [add_comm_group α] : add_group α` applies to all type-class
resolution problems of the form `add_group _`, and type-class inference will then do an
exhaustive search to find a commutative group. These instances take a long time to fail.
Other instances will only apply if the goal has a certain shape. For example
`int.add_group : add_group ℤ` or
`add_group.prod {α β} [add_group α] [add_group β] : add_group (α × β)`. Usually these instances
will fail quickly, and when they apply, they are almost the desired instance.
For this reason, we want the instances of the second type (that only apply in specific cases) to
always have higher priority than the instances of the first type (that always apply).
See also #1561.

Therefore, if we create an instance that always applies, we set the priority of these instances to
100 (or something similar, which is below the default value of 1000).
-/
library_note "lower instance priority"

/-- A linter object for checking instance priorities of instances that always apply.
This is in the default linter set. -/
@[linter] meta def linter.instance_priority : linter :=
{ test := instance_priority,
  no_errors_found := "All instance priorities are good.",
  errors_found := "DANGEROUS INSTANCE PRIORITIES.
The following instances always apply, and therefore should have a priority < 1000.
If you don't know what priority to choose, use priority 100.
See note [lower instance priority] for instructions to change the priority.",
  auto_decls := tt }

/-- Reports declarations of types that do not have an associated `inhabited` instance. -/
private meta def has_inhabited_instance (d : declaration) : tactic (option string) := do
tt ← pure d.is_trusted | pure none,
ff ← has_attribute' `reducible d.to_name | pure none,
ff ← has_attribute' `class d.to_name | pure none,
(_, ty) ← open_pis d.type,
ty ← whnf ty,
if ty = `(Prop) then pure none else do
`(Sort _) ← whnf ty | pure none,
insts ← attribute.get_instances `instance,
insts_tys ← insts.mmap $ λ i, expr.pi_codomain <$> declaration.type <$> get_decl i,
let inhabited_insts := insts_tys.filter (λ i,
  i.app_fn.const_name = ``inhabited ∨ i.app_fn.const_name = `unique),
let inhabited_tys := inhabited_insts.map (λ i, i.app_arg.get_app_fn.const_name),
if d.to_name ∈ inhabited_tys then
  pure none
else
  pure "inhabited instance missing"

/-- A linter for missing `inhabited` instances. -/
@[linter]
meta def linter.has_inhabited_instance : linter :=
{ test := has_inhabited_instance,
  auto_decls := ff,
  no_errors_found := "No types have missing inhabited instances.",
  errors_found := "TYPES ARE MISSING INHABITED INSTANCES:",
  is_fast := ff }

attribute [nolint has_inhabited_instance] pempty

/-- Checks whether an instance can never be applied. -/
private meta def impossible_instance (d : declaration) : tactic (option string) := do
  tt ← is_instance d.to_name | return none,
  (binders, _) ← get_pi_binders_nondep d.type,
  let bad_arguments := binders.filter $ λ nb, nb.2.info ≠ binder_info.inst_implicit,
  _ :: _ ← return bad_arguments | return none,
  (λ s, some $ "Impossible to infer " ++ s) <$> print_arguments bad_arguments

/-- A linter object for `impossible_instance`. -/
@[linter] meta def linter.impossible_instance : linter :=
{ test := impossible_instance,
  auto_decls := tt,
  no_errors_found := "All instances are applicable.",
  errors_found := "IMPOSSIBLE INSTANCES FOUND.
These instances have an argument that cannot be found during type-class resolution, and " ++
"therefore can never succeed. Either mark the arguments with square brackets (if it is a " ++
"class), or don't make it an instance." }

/-- Checks whether an instance can never be applied. -/
private meta def incorrect_type_class_argument (d : declaration) : tactic (option string) := do
  (binders, _) ← get_pi_binders d.type,
  let instance_arguments := binders.indexes_values $
    λ b : binder, b.info = binder_info.inst_implicit,
  /- the head of the type should either unfold to a class, or be a local constant.
  A local constant is allowed, because that could be a class when applied to the
  proper arguments. -/
  bad_arguments ← instance_arguments.mfilter (λ ⟨_, b⟩, do
    (_, head) ← open_pis b.type,
    if head.get_app_fn.is_local_constant then return ff else do
    bnot <$> is_class head),
  _ :: _ ← return bad_arguments | return none,
  (λ s, some $ "These are not classes. " ++ s) <$> print_arguments bad_arguments

/-- A linter object for `incorrect_type_class_argument`. -/
@[linter] meta def linter.incorrect_type_class_argument : linter :=
{ test := incorrect_type_class_argument,
  auto_decls := tt,
  no_errors_found := "All declarations have correct type-class arguments.",
  errors_found := "INCORRECT TYPE-CLASS ARGUMENTS.
Some declarations have non-classes between [square brackets]:" }

/-- Checks whether an instance is dangerous: it creates a new type-class problem with metavariable
arguments. -/
private meta def dangerous_instance (d : declaration) : tactic (option string) := do
  tt ← is_instance d.to_name | return none,
  (local_constants, target) ← open_pis d.type,
  let instance_arguments := local_constants.indexes_values $
    λ e : expr, e.local_binding_info = binder_info.inst_implicit,
  let bad_arguments := local_constants.indexes_values $ λ x,
      !target.has_local_constant x &&
      (x.local_binding_info ≠ binder_info.inst_implicit) &&
      instance_arguments.any (λ nb, nb.2.local_type.has_local_constant x),
  let bad_arguments : list (ℕ × binder) := bad_arguments.map $ λ ⟨n, e⟩, ⟨n, e.to_binder⟩,
  _ :: _ ← return bad_arguments | return none,
  (λ s, some $ "The following arguments become metavariables. " ++ s) <$>
    print_arguments bad_arguments

/-- A linter object for `dangerous_instance`. -/
@[linter] meta def linter.dangerous_instance : linter :=
{ test := dangerous_instance,
  no_errors_found := "No dangerous instances.",
  errors_found := "DANGEROUS INSTANCES FOUND.\nThese instances are recursive, and create a new " ++
"type-class problem which will have metavariables.
Possible solution: remove the instance attribute or make it a local instance instead.

Currently this linter does not check whether the metavariables only occur in arguments marked " ++
"with `out_param`, in which case this linter gives a false positive.",
  auto_decls := tt }

/-- Auxilliary definition for `find_nondep` -/
meta def find_nondep_aux : list expr → expr_set → tactic expr_set
| []      r := return r
| (h::hs) r :=
  do type ← infer_type h,
    find_nondep_aux hs $ r.union type.list_local_consts'

/-- Finds all hypotheses that don't occur in the target or other hypotheses. -/
meta def find_nondep : tactic (list expr) := do
  ctx ← local_context,
  tgt ← target,
  lconsts ← find_nondep_aux ctx tgt.list_local_consts',
  return $ ctx.filter $ λ e, !lconsts.contains e

/--
Tests whether type-class inference search will end quickly on certain unsolvable
type-class problems. This is to detect loops or very slow searches, which are problematic
(recall that normal type-class search often creates unsolvable subproblems, which have to fail
quickly for type-class inference to perform well.
We create these type-class problems by taking an instance, and removing the last hypothesis that
doesn't appear in the goal (or a later hypothesis). Note: this argument is necessarily an
instance-implicit argument if it passes the `linter.incorrect_type_class_argument`.
This tactic succeeds if `mk_instance` succeeds quickly or fails quickly with the error
message that it cannot find an instance. It fails if the tactic takes too long, or if any other
error message is raised (usually a maximum depth in the search).
-/
meta def fails_quickly (max_steps : ℕ) (d : declaration) : tactic (option string) := retrieve $ do
  tt ← is_instance d.to_name | return none,
  let e := d.type,
  g ← mk_meta_var e,
  set_goals [g],
  intros,
  l@(_::_) ← find_nondep | return none, -- if all arguments occur in the goal, this instance is ok
  clear l.ilast,
  reset_instance_cache,
  state ← read,
  let state_msg := "\nState:\n" ++ to_string state,
  tgt ← target >>= instantiate_mvars,
  sum.inr msg ← retrieve_or_report_error $ tactic.try_for max_steps $ mk_instance tgt |
    return none, /- it's ok if type-class inference can find an instance with fewer hypotheses.
    This happens a lot for `has_sizeof` and `has_well_founded`, but can also happen if there is a
    noncomputable instance with fewer assumptions. -/
  return $ if "tactic.mk_instance failed to generate instance for".is_prefix_of msg then none else
    some $ (++ state_msg) $
      if msg = "try_for tactic failed, timeout" then "type-class inference timed out" else msg

/--
A linter object for `fails_quickly`.
We currently set the number of steps in the type-class search pretty high.
Some instances take quite some time to fail, and we seem to run against the caching issue in
https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/odd.20repeated.20type.20class.20search
-/
@[linter] meta def linter.fails_quickly : linter :=
{ test := fails_quickly 15000,
  auto_decls := tt,
  no_errors_found := "No type-class searches timed out.",
  errors_found := "TYPE CLASS SEARCHES TIMED OUT.
The following instances are part of a loop, or an excessively long search.
It is common that the loop occurs in a different class than the one flagged below,
but usually an instance that is part of the loop is also flagged.
To debug:
(1) run `scripts/mk_all.sh` and create a file with `import all` and
`set_option trace.class_instances true`
(2) Recreate the state shown in the error message. You can do this easily by copying the type of
the instance (the output of `#check @my_instance`), turning this into an example and removing the
last argument in square brackets. Prove the example using `by apply_instance`.
For example, if `additive.topological_add_group` raises an error, run
```
example {G : Type*} [topological_space G] [group G] : topological_add_group (additive G) :=
by apply_instance
```
(3) What error do you get?
(3a) If the error is \"tactic.mk_instance failed to generate instance\",
there might be nothing wrong. But it might take unreasonably long for the type-class inference to
fail. Check the trace to see if type-class inference takes any unnecessary long unexpected turns.
If not, feel free to increase the value in the definition of the linter `fails_quickly`.
(3b) If the error is \"maximum class-instance resolution depth has been reached\" there is almost
certainly a loop in the type-class inference. Find which instance causes the type-class inference to
go astray, and fix that instance.",
  is_fast := ff }

/-- Checks that all uses of the `@[class]` attribute apply to structures or inductive types.
  This is future-proofing for lean 4, which no longer supports `@[class] def`. -/
private meta def class_structure (n : name) : tactic (option string) := do
  is_class ← has_attribute' `class n,
  if is_class then do
    env ← get_env,
    pure $ if env.is_inductive n then none else
      "is a non-structure or inductive type marked @[class]"
  else pure none

/-- A linter object for `class_structure`. -/
@[linter] meta def linter.class_structure : linter :=
{ test := λ d, class_structure d.to_name,
  auto_decls := tt,
  no_errors_found := "All classes are structures.",
  errors_found := "USE OF @[class] def IS DISALLOWED:" }

/--
Tests whether there is no instance of type `has_coe α t` where `α` is a variable,
or `has_coe t α` where `α` does not occur in `t`.
See note [use has_coe_t].
-/
private meta def has_coe_variable (d : declaration) : tactic (option string) := do
tt ← is_instance d.to_name | return none,
`(has_coe %%a %%b) ← return d.type.pi_codomain | return none,
if a.is_var then
  return $ some $ "illegal instance, first argument is variable"
else if b.is_var ∧ ¬ b.occurs a then
  return $ some $ "illegal instance, second argument is variable not occurring in first argument"
else
  return none

/-- A linter object for `has_coe_variable`. -/
@[linter] meta def linter.has_coe_variable : linter :=
{ test := has_coe_variable,
  auto_decls := tt,
  no_errors_found := "No invalid `has_coe` instances.",
  errors_found := "INVALID `has_coe` INSTANCES.
Make the following declarations instances of the class `has_coe_t` instead of `has_coe`." }

/-- Checks whether a declaration is prop-valued and takes an `inhabited _` argument that is unused
elsewhere in the type. In this case, that argument can be replaced with `nonempty _`. -/
private meta def inhabited_nonempty (d : declaration) : tactic (option string) :=
do tt ← is_prop d.type | return none,
   (binders, _) ← get_pi_binders_nondep d.type,
   let inhd_binders := binders.filter $ λ pr, pr.2.type.is_app_of `inhabited,
   if inhd_binders.length = 0 then return none
   else (λ s, some $ "The following `inhabited` instances should be `nonempty`. " ++ s) <$>
      print_arguments inhd_binders

/-- A linter object for `inhabited_nonempty`. -/
@[linter] meta def linter.inhabited_nonempty : linter :=
{ test := inhabited_nonempty,
  auto_decls := ff,
  no_errors_found := "No uses of `inhabited` arguments should be replaced with `nonempty`.",
  errors_found := "USES OF `inhabited` SHOULD BE REPLACED WITH `nonempty`." }

/-- Checks whether a declaration is `Prop`-valued and takes a `decidable* _`
hypothesis that is unused lsewhere in the type.
In this case, that hypothesis can be replaced with `classical` in the proof.
Theorems in the `decidable` namespace are exempt from the check. -/
private meta def decidable_classical (d : declaration) : tactic (option string) :=
do tt ← is_prop d.type | return none,
   ff ← pure $ (`decidable).is_prefix_of d.to_name | return none,
   (binders, _) ← get_pi_binders_nondep d.type,
   let deceq_binders := binders.filter $ λ pr, pr.2.type.is_app_of `decidable_eq
     ∨ pr.2.type.is_app_of `decidable_pred ∨ pr.2.type.is_app_of `decidable_rel
     ∨ pr.2.type.is_app_of `decidable,
   if deceq_binders.length = 0 then return none
   else (λ s, some $ "The following `decidable` hypotheses should be replaced with
                      `classical` in the proof. " ++ s) <$>
      print_arguments deceq_binders

/-- A linter object for `decidable_classical`. -/
@[linter] meta def linter.decidable_classical : linter :=
{ test := decidable_classical,
  auto_decls := ff,
  no_errors_found := "No uses of `decidable` arguments should be replaced with `classical`.",
  errors_found := "USES OF `decidable` SHOULD BE REPLACED WITH `classical` IN THE PROOF." }

/- The file `logic/basic.lean` emphasizes the differences between what holds under classical
and non-classical logic. It makes little sense to make all these lemmas classical, so we add them
to the list of lemmas which are not checked by the linter `decidable_classical`. -/
attribute [nolint decidable_classical] dec_em dec_em' not.decidable_imp_symm

private meta def has_coe_to_fun_linter (d : declaration) : tactic (option string) :=
retrieve $ do
tt ← return d.is_trusted | pure none,
mk_meta_var d.type >>= set_goals ∘ pure,
args ← unfreezing intros,
expr.sort _ ← target | pure none,
let ty : expr := (expr.const d.to_name d.univ_levels).mk_app args,
some coe_fn_inst ←
  try_core $ to_expr ``(_root_.has_coe_to_fun %%ty _) >>= mk_instance | pure none,
set_bool_option `pp.all true,
some trans_inst@(expr.app (expr.app _ trans_inst_1) trans_inst_2) ←
  try_core $ to_expr ``(@_root_.coe_fn_trans %%ty _ _ _ _) | pure none,
tt ← succeeds $ unify trans_inst coe_fn_inst transparency.reducible | pure none,
set_bool_option `pp.all true,
trans_inst_1 ← pp trans_inst_1,
trans_inst_2 ← pp trans_inst_2,
pure $ format.to_string $
  "`has_coe_to_fun` instance is definitionally equal to a transitive instance composed of: " ++
  trans_inst_1.group.indent 2 ++
  format.line ++ "and" ++
  trans_inst_2.group.indent 2

/-- Linter that checks whether `has_coe_to_fun` instances comply with Note [function coercion]. -/
@[linter] meta def linter.has_coe_to_fun : linter :=
{ test := has_coe_to_fun_linter,
  auto_decls := tt,
  no_errors_found := "has_coe_to_fun is used correctly",
  errors_found := "INVALID/MISSING `has_coe_to_fun` instances.
You should add a `has_coe_to_fun` instance for the following types.
See Note [function coercion]." }

/--
Checks whether an instance contains a semireducible non-instance with a class as
type in its value. We add some restrictions to get not too many false positives:
* We only consider classes with an `add` or `mul` field, since those classes are most likely to
  occur as a field to another class, and be an extension of another class.
* We only consider instances of type-valued classes and non-instances that are definitions.
* We currently ignore declarations `foo` that have a `foo._main` declaration. We could look inside,
or at the generated equation lemmas, but it's unlikely that there are many problematic instances
defined using the equation compiler.
-/
meta def check_reducible_non_instances (d : declaration) : tactic (option string) := do
  tt ← is_instance d.to_name | return none,
  ff ← is_prop d.type | return none,
  env ← get_env,
  -- We only check if the class of the instance contains an `add` or a `mul` field.
  let cls := d.type.pi_codomain.get_app_fn.const_name,
  some constrs ← return $ env.structure_fields cls | return none,
  tt ← return $ constrs.mem `add || constrs.mem `mul | return none,
  l ← d.value.list_constant.mfilter $ λ nm, do
  { d ← env.get nm,
    ff ← is_instance nm | return ff,
    tt ← is_class d.type | return ff,
    tt ← return d.is_definition | return ff,
    -- We only check if the class of the non-instance contains an `add` or a `mul` field.
    let cls := d.type.pi_codomain.get_app_fn.const_name,
    some constrs ← return $ env.structure_fields cls | return ff,
    tt ← return $ constrs.mem `add || constrs.mem `mul | return ff,
    ff ← has_attribute' `reducible nm | return ff,
    return tt },
  if l.empty then return none else
  -- we currently ignore declarations that have a `foo._main` declaration.
  if l.to_list = [d.to_name ++ `_main] then return none else
    return $ some $ "This instance contains the declarations " ++ to_string l.to_list ++
      ", which are semireducible non-instances."

/-- A linter that checks whether an instance contains a semireducible non-instance. -/
@[linter]
meta def linter.check_reducibility : linter :=
{ test := check_reducible_non_instances,
  auto_decls := ff,
  no_errors_found :=
    "All non-instances are reducible.",
  errors_found := "THE FOLLOWING INSTANCES MIGHT NOT REDUCE.
These instances contain one or more declarations that are not instances and are also not marked
`@[reducible]`. This means that type-class inference cannot unfold these declarations, " ++
"which might mean that type-class inference cannot infer that two instances are definitionally " ++
"equal. This can cause unexpected errors when this class occurs " ++
"as an *argument* to a type-class problem. See note [reducible non-instances].",
  is_fast := tt }


import .precofibration_category

universes v u

namespace homotopy_theory.cofibrations
open category_theory category_theory.category
open precofibration_category

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

-- These are the cofibrations in the arrow category of C with the "projective" structure.
structure cof_square {a₁ a₂ b₁ b₂ : C} (a : a₁ ⟶ a₂) (b : b₁ ⟶ b₂) : Type (max u v) :=
(f₁ : a₁ ⟶ b₁)
(f₂ : a₂ ⟶ b₂)
(hs : f₁ ≫ b = a ≫ f₂)
(hf₁ : is_cof f₁)
(hf₂ : is_cof ((pushout_by_cof f₁ a hf₁).is_pushout.induced b f₂ hs))

def cof_square.id {a₁ a₂ : C} (a : a₁ ⟶ a₂) : cof_square a a :=
⟨𝟙 a₁, 𝟙 a₂, by simp, cof_id _,
/-
  a₁ = a₁
  ↓    ↓
  a₂ = a₂
-/
 begin
   let := pushout.unique (pushout_by_cof (𝟙 a₁) a (cof_id _)).is_pushout
     (Is_pushout.refl a).transpose,
   exact cof_iso this
 end⟩

def cof_square.comp {a₁ a₂ b₁ b₂ c₁ c₂ : C} {a : a₁ ⟶ a₂} {b : b₁ ⟶ b₂} {c : c₁ ⟶ c₂}
  (f : cof_square a b) (g : cof_square b c) : cof_square a c :=
⟨f.f₁ ≫ g.f₁,
 f.f₂ ≫ g.f₂,
 by rw [assoc, g.hs, ←assoc, f.hs, assoc],
 cof_comp f.hf₁ g.hf₁,
 begin
/-
  a₁ → b₁ → c₁   All these pushouts are "transposed" from the usual layout,
  ↓  1 ↓  2 ↓    that is, the first map is horizontal and the second vertical.
  a₂ → ⬝  → ⬝
       ↓  3 ↓
       b₂ → ⬝
            ↓
            c₂
-/
   let po₁ := pushout_by_cof f.f₁ a f.hf₁,
   let po₁₂ := pushout_by_cof (f.f₁ ≫ g.f₁) a (cof_comp f.hf₁ g.hf₁),
   let k :=
     pushout_of_maps po₁.is_pushout po₁₂.is_pushout (𝟙 a₁) g.f₁ (𝟙 a₂) (by simp) (by simp),
   have po₂ : Is_pushout g.f₁ po₁.map₀ po₁₂.map₀ k :=
     Is_pushout_of_Is_pushout_of_Is_pushout_vert' po₁.is_pushout
       (by convert po₁₂.is_pushout; simp [k, pushout_of_maps])
       (by simp [k, pushout_of_maps]),
   let fc := _,
   have : is_cof fc := f.hf₂,
   let po₂₃ := pushout_by_cof g.f₁ b g.hf₁,
   let l :=
     pushout_of_maps po₁₂.is_pushout po₂₃.is_pushout f.f₁ (𝟙 c₁) f.f₂ (by simp) f.hs.symm,
   have po₃ : Is_pushout k fc l po₂₃.map₁ :=
     Is_pushout_of_Is_pushout_of_Is_pushout' po₂
       (by convert po₂₃.is_pushout; simp [l, pushout_of_maps])
       begin
         apply po₁.is_pushout.uniqueness;
         dsimp [k, fc, pushout_of_maps];
         conv { to_lhs, rw ←assoc };
         conv { to_rhs, rw ←assoc };
         simp [l, pushout_of_maps, po₂₃.is_pushout.commutes]
       end,
   let gc := _,
   have : is_cof gc := g.hf₂,
   convert cof_comp (pushout_is_cof po₃.transpose f.hf₂) g.hf₂,
   simp [l, induced_pushout_of_maps]
 end⟩

section is_cof_square

/- This "flatter" representation is helpful when trying to prove that a square's
  corner map is a cofibration by expressing it as (non-definitionally equal to)
  a composition of two such squares. -/

variables {a₁ a₂ b₁ b₂ c₁ c₂ : C} (a : a₁ ⟶ a₂) (b : b₁ ⟶ b₂) {c : c₁ ⟶ c₂}
variables (f₁ : a₁ ⟶ b₁) (f₂ : a₂ ⟶ b₂) {g₁ : b₁ ⟶ c₁} {g₂ : b₂ ⟶ c₂}
variables {h₁ : a₁ ⟶ c₁} {h₂ : a₂ ⟶ c₂}

def is_cof_square : Prop :=
∃ s : cof_square a b, s.f₁ = f₁ ∧ s.f₂ = f₂

variables {a b f₁ f₂}

lemma is_cof_square.corner_cof (H : is_cof_square a b f₁ f₂) :
  ∃ (hf₁ : is_cof f₁) (hs : f₁ ≫ b = a ≫ f₂),
  is_cof ((pushout_by_cof f₁ a hf₁).is_pushout.induced b f₂ hs) :=
begin
  rcases H with ⟨c, hc₁, hc₂⟩,
  subst f₁,
  subst f₂,
  exact ⟨c.hf₁, c.hs, c.hf₂⟩
end

lemma is_cof_square_comp (Hf : is_cof_square a b f₁ f₂) (Hg : is_cof_square b c g₁ g₂)
  (Hh₁ : h₁ = f₁ ≫ g₁) (Hh₂ : h₂ = f₂ ≫ g₂) : is_cof_square a c h₁ h₂ :=
begin
  rcases Hf with ⟨cf, hcf₁, hcf₂⟩,
  rcases Hg with ⟨cg, hcg₁, hcg₂⟩,
  subst f₁, subst f₂, subst g₁, subst g₂, subst h₁, subst h₂,
  exact ⟨cf.comp cg, rfl, rfl⟩
end

end is_cof_square

end homotopy_theory.cofibrations


universes u v

theorem eqLitOfSize0 {α : Type u} (a : Array α) (hsz : a.size = 0) : a = #[] :=
a.toArrayLitEq 0 hsz

theorem eqLitOfSize1 {α : Type u} (a : Array α) (hsz : a.size = 1) : a = #[a.getLit 0 hsz (ofDecideEqTrue rfl)] :=
a.toArrayLitEq 1 hsz

theorem eqLitOfSize2 {α : Type u} (a : Array α) (hsz : a.size = 2) : a = #[a.getLit 0 hsz (ofDecideEqTrue rfl), a.getLit 1 hsz (ofDecideEqTrue rfl)] :=
a.toArrayLitEq 2 hsz

theorem eqLitOfSize3 {α : Type u} (a : Array α) (hsz : a.size = 3) :
  a = #[a.getLit 0 hsz (ofDecideEqTrue rfl), a.getLit 1 hsz (ofDecideEqTrue rfl), a.getLit 2 hsz (ofDecideEqTrue rfl)] :=
a.toArrayLitEq 3 hsz

/-
Matcher for the following patterns
```
| #[]           => _
| #[a₁]         => _
| #[a₁, a₂, a₃] => _
| a             => _
``` -/
def matchArrayLit {α : Type u} (C : Array α → Sort v) (a : Array α)
    (h₁ : Unit →      C #[])
    (h₂ : ∀ a₁,       C #[a₁])
    (h₃ : ∀ a₁ a₂ a₃, C #[a₁, a₂, a₃])
    (h₄ : ∀ a,        C a)
    : C a :=
if h : a.size = 0 then
  @Eq.rec _ _ (fun x _ => C x) (h₁ ()) _ (a.toArrayLitEq 0 h).symm
else if h : a.size = 1 then
  @Eq.rec _ _ (fun x _ => C x) (h₂ (a.getLit 0 h (ofDecideEqTrue rfl))) _ (a.toArrayLitEq 1 h).symm
else if h : a.size = 3 then
  @Eq.rec _ _ (fun x _ => C x) (h₃ (a.getLit 0 h (ofDecideEqTrue rfl)) (a.getLit 1 h (ofDecideEqTrue rfl)) (a.getLit 2 h (ofDecideEqTrue rfl))) _ (a.toArrayLitEq 3 h).symm
else
  h₄ a

/- Equational lemmas that should be generated automatically. -/
theorem matchArrayLit.eq1 {α : Type u} (C : Array α → Sort v)
    (h₁ : Unit →      C #[])
    (h₂ : ∀ a₁,       C #[a₁])
    (h₃ : ∀ a₁ a₂ a₃, C #[a₁, a₂, a₃])
    (h₄ : ∀ a,        C a)
    : matchArrayLit C #[] h₁ h₂ h₃ h₄ = h₁ () :=
rfl

theorem matchArrayLit.eq2 {α : Type u} (C : Array α → Sort v)
    (h₁ : Unit →      C #[])
    (h₂ : ∀ a₁,       C #[a₁])
    (h₃ : ∀ a₁ a₂ a₃, C #[a₁, a₂, a₃])
    (h₄ : ∀ a,        C a)
    (a₁ : α)
    : matchArrayLit C #[a₁] h₁ h₂ h₃ h₄ = h₂ a₁ :=
rfl

theorem matchArrayLit.eq3 {α : Type u} (C : Array α → Sort v)
    (h₁ : Unit →      C #[])
    (h₂ : ∀ a₁,       C #[a₁])
    (h₃ : ∀ a₁ a₂ a₃, C #[a₁, a₂, a₃])
    (h₄ : ∀ a,        C a)
    (a₁ a₂ a₃ : α)
    : matchArrayLit C #[a₁, a₂, a₃] h₁ h₂ h₃ h₄ = h₃ a₁ a₂ a₃ :=
rfl


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module data.sum.interval
! leanprover-community/mathlib commit 861a26926586cd46ff80264d121cdb6fa0e35cc1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Sum.Order
import Mathlib.Order.LocallyFinite

/-!
# Finite intervals in a disjoint union

This file provides the `LocallyFiniteOrder` instance for the disjoint sum of two orders.

## TODO

Do the same for the lexicographic sum of orders.
-/

open Function Sum

namespace Finset

variable {α₁ α₂ β₁ β₂ γ₁ γ₂ : Type _}

section SumLift₂

variable (f f₁ g₁ : α₁ → β₁ → Finset γ₁) (g f₂ g₂ : α₂ → β₂ → Finset γ₂)

/-- Lifts maps `α₁ → β₁ → Finset γ₁` and `α₂ → β₂ → Finset γ₂` to a map
`α₁ ⊕ α₂ → β₁ ⊕ β₂ → Finset (γ₁ ⊕ γ₂)`. Could be generalized to `Alternative` functors if we can
make sure to keep computability and universe polymorphism. -/
@[simp]
def sumLift₂ : ∀ (_ : Sum α₁ α₂) (_ : Sum β₁ β₂), Finset (Sum γ₁ γ₂)
  | inl a, inl b => (f a b).map Embedding.inl
  | inl _, inr _ => ∅
  | inr _, inl _ => ∅
  | inr a, inr b => (g a b).map Embedding.inr
#align finset.sum_lift₂ Finset.sumLift₂

variable {f f₁ g₁ g f₂ g₂} {a : Sum α₁ α₂} {b : Sum β₁ β₂} {c : Sum γ₁ γ₂}

theorem mem_sumLift₂ :
    c ∈ sumLift₂ f g a b ↔
      (∃ a₁ b₁ c₁, a = inl a₁ ∧ b = inl b₁ ∧ c = inl c₁ ∧ c₁ ∈ f a₁ b₁) ∨
        ∃ a₂ b₂ c₂, a = inr a₂ ∧ b = inr b₂ ∧ c = inr c₂ ∧ c₂ ∈ g a₂ b₂ := by
  constructor
  · cases' a with a a <;> cases' b with b b
    · rw [sumLift₂, mem_map]
      rintro ⟨c, hc, rfl⟩
      exact Or.inl ⟨a, b, c, rfl, rfl, rfl, hc⟩
    · refine' fun h ↦ (not_mem_empty _ h).elim
    · refine' fun h ↦ (not_mem_empty _ h).elim
    · rw [sumLift₂, mem_map]
      rintro ⟨c, hc, rfl⟩
      exact Or.inr ⟨a, b, c, rfl, rfl, rfl, hc⟩
  · rintro (⟨a, b, c, rfl, rfl, rfl, h⟩ | ⟨a, b, c, rfl, rfl, rfl, h⟩) <;> exact mem_map_of_mem _ h
#align finset.mem_sum_lift₂ Finset.mem_sumLift₂

theorem inl_mem_sumLift₂ {c₁ : γ₁} :
    inl c₁ ∈ sumLift₂ f g a b ↔ ∃ a₁ b₁, a = inl a₁ ∧ b = inl b₁ ∧ c₁ ∈ f a₁ b₁ := by
  rw [mem_sumLift₂, or_iff_left]
  simp only [inl.injEq, exists_and_left, exists_eq_left']
  rintro ⟨_, _, c₂, _, _, h, _⟩
  exact inl_ne_inr h
#align finset.inl_mem_sum_lift₂ Finset.inl_mem_sumLift₂

theorem inr_mem_sumLift₂ {c₂ : γ₂} :
    inr c₂ ∈ sumLift₂ f g a b ↔ ∃ a₂ b₂, a = inr a₂ ∧ b = inr b₂ ∧ c₂ ∈ g a₂ b₂ := by
  rw [mem_sumLift₂, or_iff_right]
  simp only [inr.injEq, exists_and_left, exists_eq_left']
  rintro ⟨_, _, c₂, _, _, h, _⟩
  exact inr_ne_inl h
#align finset.inr_mem_sum_lift₂ Finset.inr_mem_sumLift₂

theorem sumLift₂_eq_empty :
    sumLift₂ f g a b = ∅ ↔
      (∀ a₁ b₁, a = inl a₁ → b = inl b₁ → f a₁ b₁ = ∅) ∧
        ∀ a₂ b₂, a = inr a₂ → b = inr b₂ → g a₂ b₂ = ∅ := by
  refine' ⟨fun h ↦ _, fun h ↦ _⟩
  · constructor <;>
    · rintro a b rfl rfl
      exact map_eq_empty.1 h
  cases a <;> cases b
  · exact map_eq_empty.2 (h.1 _ _ rfl rfl)
  · rfl
  · rfl
  · exact map_eq_empty.2 (h.2 _ _ rfl rfl)
#align finset.sum_lift₂_eq_empty Finset.sumLift₂_eq_empty

theorem sumLift₂_nonempty :
    (sumLift₂ f g a b).Nonempty ↔
      (∃ a₁ b₁, a = inl a₁ ∧ b = inl b₁ ∧ (f a₁ b₁).Nonempty) ∨
        ∃ a₂ b₂, a = inr a₂ ∧ b = inr b₂ ∧ (g a₂ b₂).Nonempty := by
  simp only [nonempty_iff_ne_empty, Ne, sumLift₂_eq_empty, not_and_or, not_forall, not_imp]
#align finset.sum_lift₂_nonempty Finset.sumLift₂_nonempty

theorem sumLift₂_mono (h₁ : ∀ a b, f₁ a b ⊆ g₁ a b) (h₂ : ∀ a b, f₂ a b ⊆ g₂ a b) :
    ∀ a b, sumLift₂ f₁ f₂ a b ⊆ sumLift₂ g₁ g₂ a b
  | inl _, inl _ => map_subset_map.2 (h₁ _ _)
  | inl _, inr _ => Subset.rfl
  | inr _, inl _ => Subset.rfl
  | inr _, inr _ => map_subset_map.2 (h₂ _ _)
#align finset.sum_lift₂_mono Finset.sumLift₂_mono

end SumLift₂

end Finset

open Finset Function

namespace Sum

variable {α β : Type _}

/-! ### Disjoint sum of orders -/

section Disjoint

variable [Preorder α] [Preorder β] [LocallyFiniteOrder α] [LocallyFiniteOrder β]

instance : LocallyFiniteOrder (Sum α β)
    where
  finsetIcc := sumLift₂ Icc Icc
  finsetIco := sumLift₂ Ico Ico
  finsetIoc := sumLift₂ Ioc Ioc
  finsetIoo := sumLift₂ Ioo Ioo
  finset_mem_Icc := by rintro (a | a) (b | b) (x | x) <;> simp
  finset_mem_Ico := by rintro (a | a) (b | b) (x | x) <;> simp
  finset_mem_Ioc := by rintro (a | a) (b | b) (x | x) <;> simp
  finset_mem_Ioo := by rintro (a | a) (b | b) (x | x) <;> simp

variable (a₁ a₂ : α) (b₁ b₂ : β) (a b : Sum α β)

theorem Icc_inl_inl : Icc (inl a₁ : Sum α β) (inl a₂) = (Icc a₁ a₂).map Embedding.inl :=
  rfl
#align sum.Icc_inl_inl Sum.Icc_inl_inl

theorem Ico_inl_inl : Ico (inl a₁ : Sum α β) (inl a₂) = (Ico a₁ a₂).map Embedding.inl :=
  rfl
#align sum.Ico_inl_inl Sum.Ico_inl_inl

theorem Ioc_inl_inl : Ioc (inl a₁ : Sum α β) (inl a₂) = (Ioc a₁ a₂).map Embedding.inl :=
  rfl
#align sum.Ioc_inl_inl Sum.Ioc_inl_inl

theorem Ioo_inl_inl : Ioo (inl a₁ : Sum α β) (inl a₂) = (Ioo a₁ a₂).map Embedding.inl :=
  rfl
#align sum.Ioo_inl_inl Sum.Ioo_inl_inl

@[simp]
theorem Icc_inl_inr : Icc (inl a₁) (inr b₂) = ∅ :=
  rfl
#align sum.Icc_inl_inr Sum.Icc_inl_inr

@[simp]
theorem Ico_inl_inr : Ico (inl a₁) (inr b₂) = ∅ :=
  rfl
#align sum.Ico_inl_inr Sum.Ico_inl_inr

@[simp]
theorem Ioc_inl_inr : Ioc (inl a₁) (inr b₂) = ∅ :=
  rfl
#align sum.Ioc_inl_inr Sum.Ioc_inl_inr

@[simp, nolint simpNF] -- Porting note: dsimp can not prove this
theorem Ioo_inl_inr : Ioo (inl a₁) (inr b₂) = ∅ := by
  rfl
#align sum.Ioo_inl_inr Sum.Ioo_inl_inr

@[simp]
theorem Icc_inr_inl : Icc (inr b₁) (inl a₂) = ∅ :=
  rfl
#align sum.Icc_inr_inl Sum.Icc_inr_inl

@[simp]
theorem Ico_inr_inl : Ico (inr b₁) (inl a₂) = ∅ :=
  rfl
#align sum.Ico_inr_inl Sum.Ico_inr_inl

@[simp]
theorem Ioc_inr_inl : Ioc (inr b₁) (inl a₂) = ∅ :=
  rfl
#align sum.Ioc_inr_inl Sum.Ioc_inr_inl

@[simp, nolint simpNF] -- Porting note: dsimp can not prove this
theorem Ioo_inr_inl : Ioo (inr b₁) (inl a₂) = ∅ := by
  rfl
#align sum.Ioo_inr_inl Sum.Ioo_inr_inl

theorem Icc_inr_inr : Icc (inr b₁ : Sum α β) (inr b₂) = (Icc b₁ b₂).map Embedding.inr :=
  rfl
#align sum.Icc_inr_inr Sum.Icc_inr_inr

theorem Ico_inr_inr : Ico (inr b₁ : Sum α β) (inr b₂) = (Ico b₁ b₂).map Embedding.inr :=
  rfl
#align sum.Ico_inr_inr Sum.Ico_inr_inr

theorem Ioc_inr_inr : Ioc (inr b₁ : Sum α β) (inr b₂) = (Ioc b₁ b₂).map Embedding.inr :=
  rfl
#align sum.Ioc_inr_inr Sum.Ioc_inr_inr

theorem Ioo_inr_inr : Ioo (inr b₁ : Sum α β) (inr b₂) = (Ioo b₁ b₂).map Embedding.inr :=
  rfl
#align sum.Ioo_inr_inr Sum.Ioo_inr_inr

end Disjoint

end Sum


inductive DataType
  | TInt
  | TFloat
  | TString

open DataType

inductive DataEntry
  | EInt (i : Int)
  | EFloat (f : Float)
  | EString (s : String)
  | NULL

def NULL := DataEntry.NULL

instance : Coe Int DataEntry where
  coe := DataEntry.EInt

instance : Coe Float DataEntry where
  coe := DataEntry.EFloat

instance : OfNat DataEntry n where
  ofNat := DataEntry.EInt n

instance : OfScientific DataEntry where
  ofScientific m s e := DataEntry.EFloat (OfScientific.ofScientific m s e)

instance : Coe String DataEntry where
  coe := DataEntry.EString

namespace DataEntry

@[simp] def isOf (e : DataEntry) (t : DataType) : Prop :=
  match e, t with
  | EInt _,    TInt    => True
  | EFloat _,  TFloat  => True
  | EString _, TString => True
  | NULL,      _       => True
  | _,         _       => False

end DataEntry

abbrev Header := List (DataType × String)

def Header.colTypes (h : Header) : List DataType :=
  h.map fun x => x.1

def Header.colNames (h : Header) : List String :=
  h.map fun x => x.2

abbrev Row := List DataEntry

@[simp] def rowOfTypes : Row → List DataType → Prop
  | [],       []       => True
  | eh :: et, th :: tt => eh.isOf th ∧ rowOfTypes et tt
  | _,        _        => False

@[simp] def rowsOfTypes : List Row → List DataType → Prop
  | row :: rows, types => rowOfTypes row types ∧ rowsOfTypes rows types
  | [],          _     => True

structure DataFrame where
  header     : Header
  rows       : List Row
  consistent : rowsOfTypes rows header.colTypes := by simp

namespace DataFrame

def empty (header : Header := []) : DataFrame :=
  ⟨header, [], by simp⟩

theorem consistentConcatOfConsistentRow
    {df : DataFrame} (row : List DataEntry)
    (hc : rowOfTypes row df.header.colTypes) :
      rowsOfTypes (df.rows.concat row) (Header.colTypes df.header) :=
  match df with
    | ⟨_, rows, hr⟩ => by
      induction rows with
        | nil         => simp at hc; simp [hc]
        | cons _ _ hi => exact ⟨hr.1, hi hr.2 hc⟩

def addRow (df : DataFrame) (row : List DataEntry)
    (h : rowOfTypes row df.header.colTypes := by simp) : DataFrame :=
  ⟨df.header, df.rows.concat row, consistentConcatOfConsistentRow row h⟩

end DataFrame

def h : Header := [(TInt, "id"), (TString, "name")]

def r : List Row := [[1, "alex"]]

-- this no longer works
def df1 : DataFrame := DataFrame.mk h r

-- and this ofc breaks now
def df2 : DataFrame := df1.addRow [2, "juddy"]

-- this doesn't work anymore either
def df3 : DataFrame := DataFrame.empty h |>.addRow [3, "john"]


import hilbert.wr.dc_pt

namespace clfrags
    namespace hilbert
        namespace wr
            namespace dc_pt

                theorem dc₁_pt {a b c d e : Prop}  (h₁ : pt d e a) (h₂ : pt d e b) : pt d e (dc a b c) :=
                    have h₃ : dc (pt d e a) (pt d e b) (pt d e c), from dc.dc₁ h₁ h₂,
                    show pt d e (dc a b c), from dcpt₄ h₃

                theorem dc₂_pt {a b c d : Prop} (h₁ : pt c d (dc b a a)) : pt c d a :=
                    dc.dc₂ (dcpt₃ h₁)

                theorem dc₃_pt {a b c d: Prop} (h₁ : pt c d a) : pt c d (dc b a a) :=
                    dcpt₄ (dc.dc₃ h₁)

                theorem dc₄_pt {a b c d e f g : Prop} (h₁ : pt f g (dc d e (dc a b c))) :
                    pt f g (dc e d (dc b a c)) :=
                    have h₂ : dc (pt f g d) (pt f g e) (pt f g (dc a b c)), from dcpt₃ h₁,
                    have h₃ : dc (pt f g d) (pt f g e) (dc (pt f g a) (pt f g b) (pt f g c)), from dcpt₅ h₂,
                    have h₄ : dc (pt f g e) (pt f g d) (dc (pt f g b) (pt f g a) (pt f g c)), from dc.dc₄ h₃,
                    have h₅ : dc (pt f g e) (pt f g d) (pt f g (dc b a c)), from dcpt₆ h₄,
                    show pt f g (dc e d (dc b a c)), from dcpt₄ h₅

                theorem dc₅_pt {a b c d e f g : Prop} (h₁ : pt f g (dc d e (dc a b c))) :
                    pt f g (dc e d (dc a c b)) :=
                    have h₂ : dc (pt f g d) (pt f g e) (pt f g (dc a b c)), from dcpt₃ h₁,
                    have h₃ : dc (pt f g d) (pt f g e) (dc (pt f g a) (pt f g b) (pt f g c)), from dcpt₅ h₂,
                    have h₄ : dc (pt f g e) (pt f g d) (dc (pt f g a) (pt f g c) (pt f g b)), from dc.dc₅ h₃,
                    have h₅ : dc (pt f g e) (pt f g d) (pt f g (dc a c b)), from dcpt₆ h₄,
                    show pt f g (dc e d (dc a c b)), from dcpt₄ h₅

                theorem dcpt₅_dc {a b c d e f g h i : Prop} (h₁ : dc h i (dc f g (pt a b (dc c d e)))) :
                    dc h i (dc f g (dc (pt a b c) (pt a b d) (pt a b e))) :=
                    dc.dc₇' (dcpt₅ (dc.dc₆' h₁))

                theorem dcpt₆_dc {a b c d e f g h i : Prop} (h₁ : dc h i (dc f g (dc (pt a b c) (pt a b d) (pt a b e)))) :
                    dc h i (dc f g (pt a b (dc c d e))) :=
                    dc.dc₇' (dcpt₆ (dc.dc₆' h₁))

                theorem dc₆_pt {a b c d e f g h i : Prop}
                    (h₁ : pt h i (dc f g (dc d e (dc a b c)))) : pt h i (dc f g (dc (dc d e a) (dc d e b) c)) :=
                    let f' := pt h i f, g' := pt h i g, d' := pt h i d, e' := pt h i e in
                        have h₂ : dc f' g' (pt h i (dc d e (dc a b c))),
                            from dcpt₃ h₁,
                        have h₃ : dc f' g' (dc d' e' (pt h i (dc a b c))),
                            from dcpt₅ h₂,
                        have h₄ : dc (dc f' g' d') (dc f' g' e') ((pt h i (dc a b c))),
                            from dc.dc₆' h₃,
                        have h₅ : dc (dc f' g' d') (dc f' g' e') (dc (pt h i a) (pt h i b) (pt h i c)),
                            from dcpt₅ h₄,
                        have h₆ : dc f' g' (dc d' e' (dc (pt h i a) (pt h i b) (pt h i c))),
                            from dc.dc₇' h₅,
                        have h₇ : dc f' g' (dc (dc d' e' (pt h i a)) (dc d' e' (pt h i b)) (pt h i c)),
                            from dc.dc₆ h₆,
                        have h₈ : dc g' f' (dc (dc d' e' (pt h i a)) (pt h i c) (dc d' e' (pt h i b))),
                            from dc.dc₅ h₇,
                        have h₉ : dc g' f' (dc (dc d' e' (pt h i a)) (pt h i c) (pt h i (dc d e b))),
                            from dcpt₆_dc h₈,
                        have h₁₀ : dc g' f' (dc (pt h i c) (pt h i (dc d e b)) (dc d' e' (pt h i a))),
                            from dc.dc₅ (dc.dc₄ h₉),
                        have h₁₁ : dc g' f' (dc (pt h i c) (pt h i (dc d e b)) (pt h i (dc d e a))),
                            from dcpt₆_dc h₁₀,
                        have h₁₂ : dc f' g' (dc (pt h i (dc d e a)) (pt h i (dc d e b)) (pt h i c)),
                            from dc.dc₅ (dc.dc₄ (dc.dc₅ h₁₁)),
                        have h₁₃ : dc f' g' (pt h i (dc (dc d e a) (dc d e b) c)),
                            from dcpt₆ h₁₂,
                        show pt h i (dc f g (dc (dc d e a) (dc d e b) c)),
                            from dcpt₄ h₁₃

                theorem dc₇_pt {a b c d e f g h i: Prop}
                    (h₁ : pt h i (dc f g (dc (dc d e a) (dc d e b) c))) : pt h i (dc f g (dc d e (dc a b c))) :=
                    let f' := pt h i f, g' := pt h i g, d' := pt h i d, e' := pt h i e in
                        have h₂ : dc f' g' (pt h i (dc (dc d e a) (dc d e b) c)),
                            from dcpt₃ h₁,
                        have h₃ : dc f' g' (dc (pt h i (dc d e a)) (pt h i (dc d e b)) (pt h i c)),
                            from dcpt₅ h₂,
                        have h₄ : dc g' f' (dc (pt h i (dc d e a)) (pt h i c) (pt h i (dc d e b))),
                            from dc.dc₅ h₃,
                        have h₅ : dc g' f' (dc (pt h i (dc d e a)) (pt h i c) (dc d' e' (pt h i b))),
                            from dcpt₅_dc h₄,
                        have h₆ : dc g' f' (dc (pt h i c) (dc d' e' (pt h i b)) (pt h i (dc d e a))),
                            from dc.dc₅ (dc.dc₄ h₅),
                        have h₇ : dc g' f' (dc (pt h i c) (dc d' e' (pt h i b)) (dc d' e' (pt h i a))),
                            from dcpt₅_dc h₆,
                        have h₈ : dc f' g' (dc (dc d' e' (pt h i a)) (dc d' e' (pt h i b)) (pt h i c)),
                            from dc.dc₅ (dc.dc₄ (dc.dc₅ h₇)),
                        have h₉ : dc f' g' (dc d' e' (dc (pt h i a) (pt h i b) (pt h i c))),
                            from dc.dc₇ h₈,
                        have h₁₀ : dc f' g' (dc d' e' (pt h i (dc a b c))),
                            from dcpt₆_dc h₉,
                        have h₁₁ : dc f' g' (pt h i (dc d e (dc a b c))),
                            from dcpt₆ h₁₀,
                        show pt h i (dc f g (dc d e (dc a b c))),
                            from dcpt₄ h₁₁

                theorem dc₄'_pt {a b c d e : Prop} (h₁ : pt d e (dc a b c)) : pt d e (dc b a c) :=
                    have h₂ : pt d e (dc (dc b a c) (dc a b c) (dc a b c)), from dc₃_pt h₁,
                    have h₃ : pt d e (dc (dc a b c) (dc b a c) (dc b a c)), from dc₄_pt h₂,
                    show pt d e (dc b a c), from dc₂_pt h₃

                theorem dc₅'_pt {a b c d e : Prop} (h₁ : pt d e (dc a b c)) : pt d e (dc a c b) :=
                    have h₂ : pt d e (dc (dc a c b) (dc a b c) (dc a b c)), from dc₃_pt h₁,
                    have h₃ : pt d e (dc (dc a b c) (dc a c b) (dc a c b)), from dc₅_pt h₂,
                    show pt d e (dc a c b), from dc₂_pt h₃

                theorem dc₆'_pt {a b c d e f g : Prop}
                   (h₁ : pt f g (dc d e (dc a b c))) : pt f g (dc (dc d e a) (dc d e b) c) :=
                   let h := dc d e (dc a b c), i := dc (dc d e a) (dc d e b) c in
                       have h₂ : pt f g (dc i h h), from dc₃_pt h₁,
                       have h₃ : pt f g (dc i h i), from dc₆_pt h₂,
                       have h₄ : pt f g (dc h i i), from dc₄'_pt h₃,
                       show pt f g i, from dc₂_pt h₄

                theorem dc₇'_pt {a b c d e f g : Prop}
                    (h₁ : pt f g (dc (dc d e a) (dc d e b) c)) : pt f g (dc d e (dc a b c)) :=
                    let h := dc d e (dc a b c), i := dc (dc d e a) (dc d e b) c in
                        have h₂ : pt f g (dc h i i), from dc₃_pt h₁,
                        have h₃ : pt f g (dc h i h), from dc₇_pt h₂,
                        have h₄ : pt f g (dc i h h), from dc₄'_pt h₃,
                        show pt f g h, from dc₂_pt h₄

                theorem pt₁_dc {a b c d e : Prop} (h₁ : dc d e a) (h₂ : dc d e b) (h₃ : dc d e c)
                    : dc d e (pt a b c) :=
                    dcpt₂ (pt.pt₁ h₁ h₂ h₃)

                theorem pt₂_dc {a b c d e : Prop} (h₁ : dc d e (pt a b c)) : dc d e (pt b a c) :=
                    dcpt₂ (pt.pt₂ (dcpt₁ h₁))

                theorem pt₃_dc {a b c d e : Prop} (h₁ : dc d e (pt a b c)) : dc d e (pt a c b) :=
                    dcpt₂ (pt.pt₃ (dcpt₁ h₁))

                theorem pt₄_dc {a b c d : Prop} (h₁ : dc c d a) : dc c d (pt a b b) :=
                    dcpt₂ (pt.pt₄ h₁)

                theorem pt₅_dc {a b c d : Prop} (h₁ : dc c d (pt a b b)) : dc c d a :=
                    pt.pt₅ (dcpt₁ h₁)

                theorem pt₆_dc {a b c d e f g : Prop} (h₁ : dc f g (pt a b (pt c d e))) :
                    dc f g (pt (pt a b c) d e) :=
                    have h₂ : pt (dc f g a) (dc f g b) (dc f g (pt c d e)), from dcpt₁ h₁,
                    have h₃ : pt (dc f g a) (dc f g b) (pt (dc f g c) (dc f g d) (dc f g e)), from dcpt₇ h₂,
                    have h₄ : pt (pt (dc f g a) (dc f g b) (dc f g c)) (dc f g d) (dc f g e), from pt.pt₆ h₃,
                    have h₅ : pt (dc f g d) (dc f g e) (pt (dc f g a) (dc f g b) (dc f g c)), from pt.pt₃ (pt.pt₂ h₄),
                    have h₆ : pt (dc f g d) (dc f g e) (dc f g (pt a b c)), from dcpt₈ h₅,
                    have h₇ : pt (dc f g (pt a b c)) (dc f g d) (dc f g e) , from pt.pt₂ (pt.pt₃ h₆),
                    show dc f g (pt (pt a b c) d e), from dcpt₂ h₇

                theorem dcpt₁_dc {a b c d e f g : Prop} (h₁ : dc f g (dc a b (pt c d e))) :
                    dc f g (pt (dc a b c) (dc a b d) (dc a b e)) :=
                    let a' := dc f g a, b' := dc f g b, d' := dc a b d, e' := dc a b e in
                        have h₁ : dc a' b' (pt c d e),
                            from dc.dc₆' h₁,
                        have h₂ : pt (dc a' b' c) (dc a' b' d) (dc a' b' e),
                            from dcpt₁ h₁,
                        have h₃ : pt (dc a' b' c) (dc a' b' d) (dc f g e'),
                            from dc₇'_pt h₂,
                        have h₄ : pt (dc a' b' c) (dc f g e') (dc a' b' d),
                            from pt.pt₃ h₃,
                        have h₅ : pt (dc a' b' c) (dc f g e') (dc f g d'),
                            from dc₇'_pt h₄,
                        have h₆ : pt (dc f g e') (dc f g d') (dc a' b' c),
                            from pt.pt₃ (pt.pt₂ h₅),
                        have h₇ : pt (dc f g e') (dc f g d') (dc f g (dc a b c)),
                            from dc₇'_pt h₆,
                        have h₈ : pt (dc f g (dc a b c)) (dc f g d') (dc f g e'),
                            from pt.pt₂ (pt.pt₃ (pt.pt₂ h₇)),
                        show dc f g (pt (dc a b c) d' e'),
                            from dcpt₂ h₈

                theorem dcpt₂_dc {a b c d e f g : Prop} (h₁ : dc f g (pt (dc a b c) (dc a b d) (dc a b e))) :
                    dc f g (dc a b (pt c d e)) :=
                    let a' := dc f g a, b' := dc f g b, d' := dc a b d, e' := dc a b e in
                        have h₂ : pt (dc f g (dc a b c)) (dc f g d') (dc f g e'),
                            from dcpt₁ h₁,
                        have h₃ : pt (dc f g (dc a b c)) (dc f g d') (dc a' b' e),
                            from dc₆'_pt h₂,
                        have h₄ : pt (dc f g (dc a b c)) (dc a' b' e) (dc f g d'),
                            from pt.pt₃ h₃,
                        have h₅ : pt (dc f g (dc a b c)) (dc a' b' e) (dc a' b' d),
                            from dc₆'_pt h₄,
                        have h₆ : pt (dc a' b' e) (dc a' b' d) (dc f g (dc a b c)),
                            from pt.pt₃ (pt.pt₂ h₅),
                        have h₇ : pt (dc a' b' e) (dc a' b' d) (dc a' b' c),
                            from dc₆'_pt h₆,
                        have h₈ : pt (dc a' b' c) (dc a' b' d) (dc a' b' e),
                            from pt.pt₂ (pt.pt₃ (pt.pt₂ h₇)),
                        have h₉ : dc a' b' (pt c d e),
                            from dcpt₂ h₈,
                        show dc f g (dc a b (pt c d e)),
                            from dc.dc₇' h₉

                theorem dcpt₃_dc {a b c d e f g : Prop} (h₁ : dc f g (pt a b (dc c d e))) :
                    dc f g (dc (pt a b c) (pt a b d) (pt a b e)) := dcpt₅ h₁

                theorem dcpt₄_dc {a b c d e f g : Prop} (h₁ : dc f g (dc (pt a b c) (pt a b d) (pt a b e))) :
                    dc f g (pt a b (dc c d e)) := dcpt₆ h₁

                -- dcpt₅_dc : done above

                -- dcpt₆_dc : done above

                theorem dcpt₇_dc {a b c d e f g h i : Prop} (h₁ : dc h i (pt f g (dc a b (pt c d e)))) :
                    dc h i (pt f g (pt (dc a b c) (dc a b d) (dc a b e))) :=
                    let f' := dc h i f, g' := dc h i g, a' := dc h i a, b' := dc h i b in
                        have h₂ : pt f' g' (dc h i (dc a b (pt c d e))), from dcpt₁ h₁,
                        have h₃ : pt f' g' (dc a' b' (pt c d e)), from dc₆'_pt h₂,
                        have h₄ : pt f' g' (pt (dc a' b' c) (dc a' b' d) (dc a' b' e)),
                            from dcpt₇ h₃,
                        have h₅ : pt (pt f' g' (dc a' b' c)) (dc a' b' d) (dc a' b' e),
                            from pt.pt₆ h₄,
                        have h₆ : pt (pt f' g' (dc a' b' c)) (dc a' b' d) (dc h i (dc a b e)),
                            from dc₇'_pt h₅,
                        have h₇ : pt (pt f' g' (dc a' b' c)) (dc h i (dc a b e)) (dc a' b' d),
                            from pt.pt₃ h₆,
                        have h₈ : pt (pt f' g' (dc a' b' c)) (dc h i (dc a b e)) (dc h i (dc a b d)),
                            from dc₇'_pt h₇,
                        have h₉ : pt f' g' (pt (dc a' b' c) (dc h i (dc a b e)) (dc h i (dc a b d))),
                            from pt.pt₇ h₈,
                        have h₁₀ : pt f' g' (pt (dc h i (dc a b e)) (dc h i (dc a b d)) (dc a' b' c)),
                            from pt.pt₃_pt (pt.pt₂_pt h₉),
                        have h₁₁ : pt (pt f' g' (dc h i (dc a b e))) (dc h i (dc a b d)) (dc a' b' c),
                            from pt.pt₆ h₁₀,
                        have h₁₂ : pt (pt f' g' (dc h i (dc a b e))) (dc h i (dc a b d)) (dc h i (dc a b c)),
                            from dc₇'_pt h₁₁,
                        have h₁₃ : pt f' g' (pt (dc h i (dc a b e)) (dc h i (dc a b d)) (dc h i (dc a b c))),
                            from pt.pt₇ h₁₂,
                        have h₁₄ : pt f' g' (pt (dc h i (dc a b c)) (dc h i (dc a b d)) (dc h i (dc a b e))),
                            from pt.pt₂_pt (pt.pt₃_pt (pt.pt₂_pt h₁₃)),
                        have h₁₅ : pt f' g' (dc h i (pt (dc a b c) (dc a b d) (dc a b e))),
                            from dcpt₈ h₁₄,
                        show dc h i (pt f g (pt (dc a b c) (dc a b d) (dc a b e))),
                            from dcpt₂ h₁₅

                theorem dcpt₈_dc {a b c d e f g h i : Prop} (h₁ : dc h i (pt f g (pt (dc a b c) (dc a b d) (dc a b e)))) :
                    dc h i (pt f g (dc a b (pt c d e))) :=
                    let f' := dc h i f, g' := dc h i g, a' := dc h i a, b' := dc h i b in
                        have h₂ : pt f' g' (dc h i (pt (dc a b c) (dc a b d) (dc a b e))),
                            from dcpt₁ h₁,
                        have h₃ : pt f' g' (pt (dc h i (dc a b c)) (dc h i (dc a b d)) (dc h i (dc a b e))),
                            from dcpt₇ h₂,
                        have h₄ : pt (pt f' g' (dc h i (dc a b c))) (dc h i (dc a b d)) (dc h i (dc a b e)),
                            from pt.pt₆ h₃,
                        have h₅ : pt (pt f' g' (dc h i (dc a b c))) (dc h i (dc a b d)) (dc a' b' e),
                            from dc₆'_pt h₄,
                        have h₆ : pt (pt f' g' (dc h i (dc a b c))) (dc a' b' e) (dc h i (dc a b d)),
                            from pt.pt₃ h₅,
                        have h₇ : pt (pt f' g' (dc h i (dc a b c))) (dc a' b' e) (dc a' b' d),
                            from dc₆'_pt h₆,
                        have h₈ : pt f' g' (pt (dc h i (dc a b c)) (dc a' b' e) (dc a' b' d)),
                            from pt.pt₇ h₇,
                        have h₉ : pt f' g' (pt (dc a' b' e) (dc a' b' d) (dc h i (dc a b c))),
                            from pt.pt₃_pt (pt.pt₂_pt h₈),
                        have h₁₀ : pt (pt f' g' (dc a' b' e)) (dc a' b' d) (dc h i (dc a b c)),
                            from pt.pt₆ h₉,
                        have h₁₁ : pt (pt f' g' (dc a' b' e)) (dc a' b' d) (dc a' b' c),
                            from dc₆'_pt h₁₀,
                        have h₁₂ : pt f' g' (pt (dc a' b' e) (dc a' b' d) (dc a' b' c)),
                            from pt.pt₇ h₁₁,
                        have h₁₃ : pt f' g' (pt (dc a' b' c) (dc a' b' d) (dc a' b' e)),
                            from pt.pt₂_pt (pt.pt₃_pt (pt.pt₂_pt h₁₂)),
                        have h₁₄ : pt f' g' (dc a' b' (pt c d e)),
                            from dcpt₈ h₁₃,
                        have h₁₅ : pt f' g' (dc h i (dc a b (pt c d e))),
                            from dc₇'_pt h₁₄,
                        show dc h i (pt f g (dc a b (pt c d e))),
                            from dcpt₂ h₁₅

                theorem pt₇_dc {a b c d e f g : Prop} (h₁ : dc f g (pt (pt a b c) d e)) : dc f g (pt a b (pt c d e)) :=
                    have h₂ : dc f g (pt d (pt a b c) e), from pt₂_dc h₁,
                    have h₃ : dc f g (pt d e (pt a b c)), from pt₃_dc h₂,
                    have h₄ : dc f g (pt (pt d e a) b c), from pt₆_dc h₃,
                    have h₅ : dc f g (pt b (pt d e a) c), from pt₂_dc h₄,
                    have h₆ : dc f g (pt b c (pt d e a)), from pt₃_dc h₅,
                    have h₇ : dc f g (pt (pt b c d) e a), from pt₆_dc h₆,
                    have h₈ : dc f g (pt e (pt b c d) a), from pt₂_dc h₇,
                    have h₉ : dc f g (pt e a (pt b c d)), from pt₃_dc h₈,
                    have h₁₀ : dc f g (pt (pt e a b) c d), from pt₆_dc h₉,
                    have h₁₁ : dc f g (pt c (pt e a b) d), from pt₂_dc h₁₀,
                    have h₁₂ : dc f g (pt c d (pt e a b)), from pt₃_dc h₁₁,
                    have h₁₃ : dc f g (pt (pt c d e) a b), from pt₆_dc h₁₂,
                    have h₁₄ : dc f g (pt a (pt c d e) b), from pt₂_dc h₁₃,
                    show dc f g (pt a b (pt c d e)), from pt₃_dc h₁₄

                theorem dcpt₁_pt {a b c d e f g : Prop} (h₁ : pt f g (dc a b (pt c d e))) :
                    pt f g (pt (dc a b c) (dc a b d) (dc a b e)) := dcpt₇ h₁

                theorem dcpt₂_pt {a b c d e f g : Prop} (h₁ : pt f g (pt (dc a b c) (dc a b d) (dc a b e))) :
                    pt f g (dc a b (pt c d e)) := dcpt₈ h₁

                theorem dcpt₃_pt {a b c d e f g : Prop} (h₁ : pt f g (pt a b (dc c d e))) :
                    pt f g (dc (pt a b c) (pt a b d) (pt a b e)) :=
                    let a' := pt f g a, c' := pt a b c, d' := pt a b d, e' := pt a b e in
                        have h₂ : pt a' b (dc c d e), from pt.pt₆ h₁,
                        have h₃ : dc (pt a' b c) (pt a' b d) (pt a' b e), from dcpt₃ h₂,
                        have h₄ : dc (pt a' b c) (pt a' b d) (pt f g e'), from pt₇_dc h₃,
                        have h₅ : dc (pt a' b c) (pt f g e') (pt a' b d), from dc.dc₅' h₄,
                        have h₆ : dc (pt a' b c) (pt f g e') (pt f g d'), from pt₇_dc h₅,
                        have h₇ : dc (pt f g e') (pt f g d') (pt a' b c), from dc.dc₅' (dc.dc₄' h₆),
                        have h₈ : dc (pt f g e') (pt f g d') (pt f g c'), from pt₇_dc h₇,
                        have h₉ : dc (pt f g c') (pt f g d') (pt f g e'), from dc.dc₄' (dc.dc₅' (dc.dc₄' h₈)),
                        show pt f g (dc c' d' e'), from dcpt₄ h₉

                theorem dcpt₄_pt {a b c d e f g : Prop} (h₁ : pt f g (dc (pt a b c) (pt a b d) (pt a b e))) :
                    pt f g (pt a b (dc c d e)) :=
                    let a' := pt f g a, c' := pt a b c, d' := pt a b d, e' := pt a b e in
                        have h₂ : dc (pt f g c') (pt f g (pt a b d)) (pt f g e'), from dcpt₃ h₁,
                        have h₃ : dc (pt f g c') (pt f g (pt a b d)) (pt a' b e), from pt₆_dc h₂,
                        have h₄ : dc (pt f g c') (pt a' b e) (pt f g (pt a b d)), from dc.dc₅' h₃,
                        have h₅ : dc (pt f g c') (pt a' b e) (pt a' b d), from pt₆_dc h₄,
                        have h₆ : dc (pt a' b e) (pt a' b d) (pt f g c'), from dc.dc₅' (dc.dc₄' h₅),
                        have h₇ : dc (pt a' b e) (pt a' b d) (pt a' b c), from pt₆_dc h₆,
                        have h₈ : dc (pt a' b c) (pt a' b d) (pt a' b e), from dc.dc₄' (dc.dc₅' (dc.dc₄' h₇)),
                        have h₉ : pt a' b (dc c d e), from dcpt₄ h₈,
                        show pt f g (pt a b (dc c d e)), from pt.pt₇ h₉

                theorem dcpt₅_pt {a b c d e f g h i : Prop} (h₁ : pt h i (dc f g (pt a b (dc c d e)))) :
                    pt h i (dc f g (dc (pt a b c) (pt a b d) (pt a b e))) :=
                    let f' := pt h i f, g' := pt h i g, a' := pt h i a, d' := pt a b d, e' := pt a b e in
                        have h₂ : dc f' g' (pt h i (pt a b (dc c d e))),
                            from dcpt₃ h₁,
                        have h₃ : dc f' g' (pt a' b (dc c d e)),
                            from pt₆_dc h₂,
                        have h₄ : dc f' g' (dc (pt a' b c) (pt a' b d) (pt a' b e)),
                            from dcpt₅ h₃,
                        have h₅ : dc (dc f' g' (pt a' b c)) (dc f' g' (pt a' b d)) (pt a' b e),
                            from dc.dc₆' h₄,
                        have h₆ : dc (dc f' g' (pt a' b c)) (dc f' g' (pt a' b d)) (pt h i e'),
                            from pt₇_dc h₅,
                        have h₇ : dc f' g' (dc (pt a' b c) (pt a' b d) (pt h i e')),
                            from dc.dc₇' h₆,
                        have h₈ : dc g' f' (dc (pt a' b c) (pt h i e') (pt a' b d)),
                            from dc.dc₅ h₇,
                        have h₉ : dc (dc g' f' (pt a' b c)) (dc g' f' (pt h i e')) (pt a' b d),
                            from dc.dc₆' h₈,
                        have h₁₀ : dc (dc g' f' (pt a' b c)) (dc g' f' (pt h i e')) (pt h i d'),
                            from pt₇_dc h₉,
                        have h₁₁ : dc g' f' (dc (pt a' b c) (pt h i e') (pt h i d')),
                            from dc.dc₇' h₁₀,
                        have h₁₂ : dc g' f' (dc (pt h i e') (pt h i d') (pt a' b c)),
                            from dc.dc₅ (dc.dc₄ h₁₁),
                        have h₁₃ : dc (dc g' f' (pt h i e')) (dc g' f' (pt h i d')) (pt a' b c),
                            from dc.dc₆' h₁₂,
                        have h₁₄ : dc (dc g' f' (pt h i e')) (dc g' f' (pt h i d')) (pt h i (pt a b c)),
                            from pt₇_dc h₁₃,
                        have h₁₅ : dc g' f' (dc (pt h i e') (pt h i d') (pt h i (pt a b c))),
                            from dc.dc₇' h₁₄,
                        have h₁₆ : dc f' g' (dc (pt h i (pt a b c)) (pt h i d') (pt h i e')),
                            from dc.dc₄ (dc.dc₅ (dc.dc₄ h₁₅)),
                        have h₁₇ : dc f' g' (pt h i (dc (pt a b c) d' e')),
                            from dcpt₆ h₁₆,
                        show pt h i (dc f g (dc (pt a b c) d' e')),
                            from dcpt₄ h₁₇

                theorem dcpt₆_pt {a b c d e f g h i : Prop} (h₁ : pt h i (dc f g (dc (pt a b c) (pt a b d) (pt a b e)))) :
                    pt h i (dc f g (pt a b (dc c d e))) :=
                    let f' := pt h i f, g' := pt h i g, a' := pt h i a, d' := pt a b d, e' := pt a b e in
                        have h₂ : dc f' g' (pt h i (dc (pt a b c) d' e')),
                            from dcpt₃ h₁,
                        have h₃ : dc f' g' (dc (pt h i (pt a b c)) (pt h i d') (pt h i e')),
                            from dcpt₅ h₂,
                        have h₄ : dc g' f' (dc (pt h i e') (pt h i d') (pt h i (pt a b c))),
                            from dc.dc₄ (dc.dc₅ (dc.dc₄ h₃)),
                        have h₅ : dc (dc g' f' (pt h i e')) (dc g' f' (pt h i d')) (pt h i (pt a b c)),
                            from dc.dc₆' h₄,
                        have h₆ : dc (dc g' f' (pt h i e')) (dc g' f' (pt h i d')) (pt a' b c),
                            from pt₆_dc h₅,
                        have h₇ : dc g' f' (dc (pt h i e') (pt h i d') (pt a' b c)),
                            from dc.dc₇' h₆,
                        have h₈ : dc g' f' (dc (pt a' b c) (pt h i e') (pt h i d')),
                            from dc.dc₄ (dc.dc₅ h₇),
                        have h₉ : dc (dc g' f' (pt a' b c)) (dc g' f' (pt h i e')) (pt h i d'),
                            from dc.dc₆' h₈,
                        have h₁₀ : dc (dc g' f' (pt a' b c)) (dc g' f' (pt h i e')) (pt a' b d),
                            from pt₆_dc h₉,
                        have h₁₁ : dc g' f' (dc (pt a' b c) (pt h i e') (pt a' b d)),
                            from dc.dc₇' h₁₀,
                        have h₁₂ : dc f' g' (dc (pt a' b c) (pt a' b d) (pt h i e')),
                            from dc.dc₅ h₁₁,
                        have h₁₃ : dc (dc f' g' (pt a' b c)) (dc f' g' (pt a' b d)) (pt h i e'),
                            from dc.dc₆' h₁₂,
                        have h₁₄ : dc (dc f' g' (pt a' b c)) (dc f' g' (pt a' b d)) (pt a' b e),
                            from pt₆_dc h₁₃,
                        have h₁₅ : dc f' g' (dc (pt a' b c) (pt a' b d) (pt a' b e)),
                            from dc.dc₇' h₁₄,
                        have h₁₆ : dc f' g' (pt a' b (dc c d e)),
                            from dcpt₆ h₁₅,
                        have h₁₇ : dc f' g' (pt h i (pt a b (dc c d e))),
                            from pt₇_dc h₁₆,
                        show pt h i (dc f g (pt a b (dc c d e))),
                            from dcpt₄ h₁₇

                theorem dcpt₇_pt {a b c d e f g h i : Prop} (h₁ : pt h i (pt f g (dc a b (pt c d e)))) :
                    pt h i (pt f g (pt (dc a b c) (dc a b d) (dc a b e))) :=
                    have h₂ : pt (pt h i f) g (dc a b (pt c d e)), from pt.pt₆ h₁,
                    have h₃ : pt (pt h i f) g (pt (dc a b c) (dc a b d) (dc a b e)), from dcpt₇ h₂,
                    show pt h i (pt f g (pt (dc a b c) (dc a b d) (dc a b e))), from pt.pt₇ h₃

                theorem dcpt₈_pt {a b c d e f g h i : Prop} (h₁ : pt h i (pt f g (pt (dc a b c) (dc a b d) (dc a b e)))) :
                    pt h i (pt f g (dc a b (pt c d e))) :=
                    have h₂ : pt (pt h i f) g (pt (dc a b c) (dc a b d) (dc a b e)), from pt.pt₆ h₁,
                    have h₃ : pt (pt h i f) g (dc a b (pt c d e)), from dcpt₈ h₂,
                    show pt h i (pt f g (dc a b (pt c d e))), from pt.pt₇ h₃

            end dc_pt
        end wr
    end hilbert
end clfrags


import .to_mathlib

local infix ` ⟹ `:65 := lattice.imp

namespace lattice

lemma context_or_elim' {β} [complete_boolean_algebra β] {Γ a b c : β} (H : Γ ≤ a ⊔ b) (H_left : ∀ {Γ'} (H_le : Γ' ≤ Γ) (H_le' : Γ' ≤ a), Γ' ≤ c) (H_right : ∀ {Γ'} (H_le : Γ' ≤ Γ) (H_le' : Γ' ≤ b), Γ' ≤ c) : Γ ≤ c :=
begin
  bv_or_elim_at H,
    { specialize @H_left Γ_1 (by simp[Γ_1]) ‹_›, from ‹_› },
    { specialize @H_right Γ_1 (by simp[Γ_1]) ‹_›, from ‹_› }
end

end lattice

namespace tactic
namespace interactive
section bv_tauto
open lean.parser lean interactive.types interactive
local postfix `?`:9001 := optional

-- takes `e`, a proof that Γ' ≤ Γ, and specializes hypotheses of the form `Γ  ≤ b` to `Γ' ≤ b`
meta def context_switch_core (e : expr) : tactic unit :=
do `(%%Γ' ≤ %%Γ) <- infer_type e,
   ctx <- local_context >>=
            (λ l, l.mfilter (λ H,
               ((do Γ'' <- (infer_type H) >>= lhs_of_le,
                 succeeds (is_def_eq Γ'' Γ))) <|> return ff)),
   ctx.mmap' ((λ H, do let n := get_name H,
                       prf <- to_expr ``(le_trans %%e %%H),
                       note n none prf,
                       tactic.clear H) : expr → tactic unit)

meta def context_switch (p : parse texpr): tactic unit :=
do e <- to_expr ``(%%p),
  context_switch_core e

-- faster version of bv_or_elim
-- TODO(jesse): `cases`-like handling of new names for the split hypotheses
-- TODO(jesse): add similar versions with bv_impl_intro and bv_exists_elim
meta def bv_or_elim_core (p : expr) : tactic unit :=
do  n <- get_unused_name "Γ",
    n_H <- get_unused_name "H_le",
    `[apply lattice.context_or_elim' %%p];
    propagate_tags ((intro_lst [n,n_H]) >> skip);
    tactic.clear p;
    resolve_name n_H >>= context_switch; intro none

meta def bv_or_elim (n : parse ident) : tactic unit :=
resolve_name n >>= to_expr >>= bv_or_elim_core

meta def auto_or_elim_aux : list expr → tactic unit
| [] := tactic.fail "auto_or_elim failed"
| (e::es) := (do `(%%Γ ≤ %%x ⊔ %%y) <- infer_type e,
                let n := get_name e,
                Γ₁ <- get_current_context >>= whnf,
                Γ₂ <- whnf Γ,
                guard (Γ₁ =ₐ Γ₂),
                bv_or_elim_core e,
                try assumption)
                <|> auto_or_elim_aux es

meta def auto_or_elim_step : tactic unit := local_context >>= auto_or_elim_aux

meta def goal_is_bv_false : tactic unit :=
do rhs <- target >>= rhs_of_le,
   match rhs with
   | `(⊥) := skip
   | _ := fail "not ⊥"
   end

meta def bv_tauto_step : tactic unit :=
do (goal_is_bv_false >> skip) <|> `[refine _root_.lattice.bv_by_contra _] >> bv_imp_intro none,
   `[try {unfold _root_.lattice.imp at *}],
   `[try {simp only with bv_push_neg at *}],
   try bv_split,
   try bv_contradiction

-- TODO(jesse): also automatically case on existentials
meta def bv_tauto (n : option ℕ := none) : tactic unit :=
match n with
| none := bv_tauto_step *> (done <|> (auto_or_elim_step; bv_tauto))
| (some k) := iterate_at_most k bv_tauto_step
end

end bv_tauto
end interactive
end tactic

example {𝔹} [lattice.nontrivial_complete_boolean_algebra 𝔹] {a b c : 𝔹} : ( a ⟹ b ) ⊓ ( b ⟹ c ) ≤ a ⟹ c :=
begin
  tidy_context, bv_tauto
end


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.coeffs
import Mathlib.PostPort

namespace Mathlib

/-
Normalized linear integer arithmetic terms.
-/

namespace omega

/-- Shadow syntax of normalized terms. The first element
    represents the constant term and the list represents
    the coefficients. -/
def term := ℤ × List ℤ

namespace term

/-- Evaluate a term using the valuation v. -/
@[simp] def val (v : ℕ → ℤ) : term → ℤ := sorry

@[simp] def neg : term → term := sorry

@[simp] def add : term → term → term := sorry

@[simp] def sub : term → term → term := sorry

@[simp] def mul (i : ℤ) : term → term := sorry

@[simp] def div (i : ℤ) : term → term := sorry

theorem val_neg {v : ℕ → ℤ} {t : term} : val v (neg t) = -val v t := sorry

@[simp] theorem val_sub {v : ℕ → ℤ} {t1 : term} {t2 : term} :
    val v (sub t1 t2) = val v t1 - val v t2 :=
  sorry

@[simp] theorem val_add {v : ℕ → ℤ} {t1 : term} {t2 : term} :
    val v (add t1 t2) = val v t1 + val v t2 :=
  sorry

@[simp] theorem val_mul {v : ℕ → ℤ} {i : ℤ} {t : term} : val v (mul i t) = i * val v t := sorry

theorem val_div {v : ℕ → ℤ} {i : ℤ} {b : ℤ} {as : List ℤ} :
    i ∣ b → (∀ (x : ℤ), x ∈ as → i ∣ x) → val v (div i (b, as)) = val v (b, as) / i :=
  sorry

/-- Fresh de Brujin index not used by any variable ocurring in the term -/
def fresh_index (t : term) : ℕ := list.length (prod.snd t)

def to_string (t : term) : string :=
  list.foldr (fun (_x : ℕ × ℤ) => sorry) (to_string (prod.fst t)) (list.enum (prod.snd t))

protected instance has_to_string : has_to_string term := has_to_string.mk to_string

end term

/-- Fresh de Brujin index not used by any variable ocurring in the list of terms -/
def terms.fresh_index : List term → ℕ := sorry

end Mathlib