import coding function
import computability.reduce
open encodable denumerable part

universes u v

local attribute [simp] set.set_of_app_iff

lemma bool.to_bool_ext (p : Prop) (D0 D1 : decidable p) :
  @to_bool p D0 = @to_bool p D1 :=
by { cases (@decidable.em p D0) with h,
     simp[to_bool_tt h], exact h, simp[to_bool_ff h], exact h, }

lemma bool.to_bool_ext_iff {p q : Prop} (r : p ↔ q) (D0 : decidable p) (D1 : decidable q) :
  @to_bool _ D0 = @to_bool _ D1 :=
by { cases (@decidable.em p D0) with h, simp[to_bool_tt h],
     exact r.mp h, simp[to_bool_ff h], exact (not_congr r).mp h, }

lemma bool.to_bool_ext_bnot (p : Prop) (D0 : decidable p) (D1 : decidable ¬p) :
  @to_bool _ D1 = !@to_bool _ D0 :=
by { cases (@decidable.em p D0) with h,
     simp[to_bool_tt h], exact h, simp[to_bool_ff h], exact h, }

lemma encode_to_bool_eq {α} {A : set α} (D0 D1 : decidable_pred A) :
  (λ n, (@to_bool (A n) (D0 n))) = (λ n, (@to_bool (A n) (D1 n))) := funext (λ x, by rw bool.to_bool_ext)

lemma decidable_pred.compl {α} {A : set α} :
  decidable_pred A → decidable_pred Aᶜ := λ h x, @not.decidable _ (h x)

noncomputable def chr {α} (p : set α)  : α → bool := λ x : α,
decidable.cases_on (classical.dec (p x)) (λ h₁, bool.ff) (λ h₂, bool.tt)

@[simp] theorem chr_tt_iff {α} (A : set α) (x : α) : chr A x = tt ↔ A x :=
by simp[chr]; cases (classical.dec (A x)); simp[h]

@[simp] theorem chr_tt_iff_r {α} (A : set α) (x : α) : tt = chr A x ↔ A x :=
by simp[chr]; cases (classical.dec (A x)); simp[h]

@[simp] theorem chr_ff_iff {α} (A : set α) (x : α) : chr A x = ff ↔ ¬A x :=
by simp[chr]; cases (classical.dec (A x)); simp[h]

@[simp] theorem chr_ff_iff_r {α} (A : set α) (x : α) : ff = chr A x ↔ ¬A x :=
by simp[chr]; cases (classical.dec (A x)); simp[h]

theorem chr_iff {α} (A : set α) (x : α) (b : bool) : chr A x = b ↔ (A x ↔ b = tt) :=
by cases b; simp

@[simp] theorem chr_app_iff {α} (A : set α) (x : α) : chr A x ↔ A x :=
by simp[chr]; cases (classical.dec (A x)); simp[h]

theorem chr_eq_to_bool {α} (A : set α) (x : α) [decidable (A x)] : chr A x = to_bool (A x) :=
by simp[chr_iff]

theorem to_bool_chr_eq {α} (A : set α) (x : α) (D : decidable (A x)) :
  to_bool (A x) = chr A x :=
by { cases (@decidable.em (A x) D) with h,
     simp[to_bool_tt h, (chr_tt_iff _ _).2 h],
     simp[to_bool_ff h, (chr_ff_iff _ _).2 h] }

theorem chr_ext {α β} {A : set α} {B : set β} {x y} : chr A x = chr B y ↔ (A x ↔ B y) :=
begin
    split,
  { assume h,
    cases e : chr A x,
    have ax := (chr_ff_iff _ _).mp e,
    have bx := (chr_ff_iff B y).mp (by simp[←h, e]), simp[ax,bx],
    have ax := (chr_tt_iff _ _).mp e,
    have bx := (chr_tt_iff B y).mp (by simp[←h, e]), simp[ax,bx] },
  { assume h,
    cases e : chr B y,
    have bx := (chr_ff_iff _ _).mp e,
    exact (chr_ff_iff A x).mpr (by simp [h, bx]),
    have bx := (chr_tt_iff _ _).mp e,
    exact (chr_tt_iff A x).mpr (by simp [h, bx]) }
end

@[simp] lemma chr_coe_bool {α} (f : α → bool) : chr {x | f x = tt} = f :=
by funext a; cases C : f a; simp; exact C

def rre_pred {α β σ} [primcodable α] [primcodable β] [primcodable σ]
  (p : set α) (f : β →. σ) : Prop :=
(λ a, part.assert (p a) (λ _, part.some ())) partrec_in f

infix ` re_in `:80 := rre_pred
prefix `r.e. `:80 := re_pred

def rre_pred_tot {α β σ} [primcodable α] [primcodable β] [primcodable σ]
  (p : set α) (f : β → σ) : Prop := p re_in ↑ᵣf

infix ` re_in! `:80 := rre_pred_tot

theorem rre_pred.re {α β σ} [primcodable α] [primcodable β] [primcodable σ]
  {A : set α} {f : β →. σ} (hA : A re_in f) (hf : partrec f) : r.e. A :=
hA.le_part_part hf

theorem rre_pred.re0 {α} [primcodable α]
  {A : set α} (hA : A re_in! chr (∅ : set ℕ)) : r.e. A :=
by { have : partrec ↑ᵣ(chr ∅ : ℕ → bool),
     { exact ((computable.const ff).of_eq $ λ x,
       by { symmetry, simp [chr_ff_iff], exact not_false }) },
     exact hA.re this }

theorem rre_in_0_iff_re {α} [primcodable α] {A : set α} :
  A re_in! chr (∅ : set ℕ) ↔ r.e. A :=
⟨rre_pred.re0, partrec.to_rpart⟩

def rcomputable_pred {α β γ} [primcodable α] [primcodable β] [primcodable γ] (A : set α) (o : β →. γ) : Prop :=
∃ [D0 : decidable_pred A],
by exactI (λ x, to_bool (A x)) computable_in o

def t_reducible {α β} [primcodable α] [primcodable β] (A : set α) (B : set β) : Prop :=
∃ [D0 : decidable_pred A] [D1 : decidable_pred B],
by exactI (λ x, to_bool (A x)) computable_in! (λ x, to_bool (B x))

infix ` ≤ₜ `:50 := t_reducible

@[reducible] def t_irreducible {α β} [primcodable α] [primcodable β] (A : set α) (B : set β) : Prop := ¬A ≤ₜ B

infix ` ≰ₜ ` :50 := t_irreducible

@[reducible] def t_reducible_lt {α β} [primcodable α] [primcodable β] (A : set α) (B : set β) : Prop :=
A ≤ₜ B ∧ ¬B ≤ₜ A

infix ` <ₜ `:50 := t_reducible_lt

def t_reducible_equiv {α β} [primcodable α] [primcodable β] (A : set α) (B : set β) : Prop :=
A ≤ₜ B ∧ B ≤ₜ A

infix ` ≡ₜ `:50 := t_reducible_equiv

def productive (A : set ℕ) : Prop :=
∃ φ : ℕ →. ℕ, partrec φ ∧ ∀ i : ℕ, W⟦i⟧ₙ⁰ ⊆ A → ∃ z, z ∈ φ i ∧ z ∈ A ∧ z ∉ W⟦i⟧ₙ⁰

def creative (A : set ℕ) : Prop := r.e. A ∧ productive Aᶜ

def immune (A : set ℕ) : Prop := infinite A ∧ ∀ e, infinite W⟦e⟧ₙ⁰ → W⟦e⟧ₙ⁰ ∩ Aᶜ ≠ ∅

def simple (A : set ℕ) : Prop := r.e. A ∧ immune Aᶜ

variables {α : Type*} {β : Type*} {γ : Type*} {σ : Type*} {τ : Type*} {μ : Type*}
variables [primcodable α] [primcodable β] [primcodable γ] [primcodable σ] [primcodable τ] [primcodable μ]

theorem classical_iff {A : set α} {B : set β} :
  A ≤ₜ B ↔ chr A computable_in! (chr B) :=
by simp[t_reducible, to_bool_chr_eq]; exact
  ⟨λ ⟨_, _, h⟩, h, λ h, ⟨classical.dec_pred _, classical.dec_pred _, h⟩⟩

theorem t_reducible.of_eq {A B : set α} {C : set β} (hA : A ≤ₜ C) (H : ∀ n, A n ↔ B n) : B ≤ₜ C :=
(set.ext H : A = B) ▸ hA

@[refl] theorem t_reducible.refl (A : set α) [D : decidable_pred A] : A ≤ₜ A := ⟨D, D, nat.rpartrec.refl⟩

@[trans] theorem t_reducible.trans {A : set α} {B : set β} {C : set γ} :
  A ≤ₜ B → B ≤ₜ C → A ≤ₜ C :=
λ ⟨Da, Db, hab⟩ ⟨Db0, Dc, hbc⟩,
⟨Da, Dc, by simp only [encode_to_bool_eq Db Db0] at hab; exact nat.rpartrec.trans hab hbc⟩

@[refl] theorem t_reducible_equiv.refl
  (A : set α) [D : decidable_pred A] :
  A ≡ₜ A :=
⟨t_reducible.refl A, t_reducible.refl A⟩

@[symm] theorem t_reducible_equiv.symm
  {A : set α} {B : set β} :
  A ≡ₜ B → B ≡ₜ A :=
and.swap

@[trans] theorem t_reducible_equiv.trans
  {A : set α} {B : set β} {C : set γ} :
  A ≡ₜ B → B ≡ₜ C → A ≡ₜ C :=
λ ⟨ab, ba⟩ ⟨bc, cb⟩, ⟨t_reducible.trans ab bc, t_reducible.trans cb ba⟩

theorem many_one_reducible.to_turing {A : set α} {B : set β} [DA : decidable_pred A] [DB : decidable_pred B] :
  A ≤₀ B → A ≤ₜ B := λ h,
⟨DA, DB, by { rcases h with ⟨f, cf, hf⟩,
 exact ((rcomputable.refl.comp (cf.to_rcomp)).of_eq $ λ n, by simp [hf]) }⟩

theorem one_one_reducible.to_turing {A : set α} {B : set β} [DA : decidable_pred A] [DB : decidable_pred B] :
  A ≤₁ B → A ≤ₜ B := λ h, h.to_many_one.to_turing

theorem reducible_compl (A : set α) [D : decidable_pred A] : Aᶜ ≤ₜ A :=
have Dc : decidable_pred Aᶜ, from D.compl,
have e0 : ∀ x, @to_bool (Aᶜ x) (Dc x) = !to_bool (A x), from λ x, bool.to_bool_ext_bnot _ _ _,
have cb : computable bnot, from (primrec.dom_bool _).to_comp,
⟨Dc, D, (cb.to_rpart.comp rcomputable.refl).of_eq $ λ x, by simp[e0]⟩

theorem equiv_compl (A : set α) [D : decidable_pred A] : Aᶜ ≡ₜ A :=
have cc : Aᶜᶜ = A, from compl_compl A,
⟨reducible_compl A, by {
  suffices : Aᶜᶜ ≤ₜ Aᶜ, rw cc at this, exact this, exact @reducible_compl _ _ Aᶜ D.compl, }⟩

theorem computable_le {A : set α} (B : set β) [D : decidable_pred B] :
  computable_pred A → A ≤ₜ B :=
λ ⟨D0, hA⟩, ⟨D0, D, nat.rpartrec.of_partrec _ hA⟩

theorem le_computable_computable {A : set α} {B : set β} :
  B ≤ₜ A → computable_pred A → computable_pred B := λ ⟨Db, Da, h⟩ ⟨Da0, hA⟩,
⟨Db, by { simp only [computable, partrec, encode_to_bool_eq Da0 Da] at hA,
          exact rpartrec.le_part_part h hA}⟩

theorem computable_equiv {A : set α} {B : set β} :
  computable_pred A → computable_pred B → A ≡ₜ B :=
λ ⟨Da, ca⟩ ⟨Db, cb⟩, ⟨@computable_le _ _ _ _ A B Db ⟨Da, ca⟩, @computable_le _ _ _ _ B A Da ⟨Db, cb⟩⟩

theorem computable_0 : computable_pred (∅ : set α) :=
⟨λ x, decidable.false, ((computable.const ff).of_eq $ λ x, rfl)⟩

theorem re_pred_0 : r.e. (∅ : set α) :=
partrec.none.of_eq (λ x, by {rw[show (∅ : set α) x = false, by refl], symmetry, simp[part.eq_none_iff] })

theorem degree0 (A : set α) :
  computable_pred A ↔ A ≡ₜ (∅ : set β) :=
⟨λ ⟨D, h⟩, ⟨computable_le _ ⟨D, h⟩, @computable_le _ _ _ _ _ _ D computable_0⟩,
 λ ⟨h, _⟩, le_computable_computable h computable_0⟩

 theorem computable_pred_iff_le {A : set α} :
  computable_pred A ↔ A ≤ₜ (∅ : set ℕ) :=
⟨λ ⟨D, h⟩, computable_le _ ⟨D, h⟩,
 λ h, le_computable_computable h computable_0⟩

theorem degree0' (A : set α) : computable_pred A ↔ A ≡ₜ (∅ : set ℕ) := degree0 A

def Join (A : ℕ → set ℕ) : set ℕ := {x | x.unpair.1 ∈ A x.unpair.2}

prefix `⨁`:90 := Join

theorem Join_one_one_reducible (A : ℕ → set ℕ) [D : ∀ n, decidable_pred (A n)] (n) : A n ≤₁ ⨁A :=
begin
  let f := (λ m : ℕ, m.mkpair n),
  have cf : computable f := (primrec₂.mkpair.comp primrec.id (primrec.const n)).to_comp,
  refine ⟨f, cf, _, _⟩,
  { intros x y h, simp[f] at h, have : x = (x.mkpair n).unpair.1, simp,
      rw this, rw h, simp },
  { intros x, simp [Join], refl }
end

theorem Join_le (A : ℕ → set ℕ) [DA : ∀ n, decidable_pred (A n)]
  (B : set ℕ) [DB : decidable_pred B] (hA : (λ x y, to_bool (A x y)) computable₂_in! λ x, to_bool (B x)) : ⨁A ≤ₜ B :=
⟨λ a, DA (nat.unpair a).2 (nat.unpair a).1, DB, by { simp[Join],
  refine hA.comp (rcomputable.snd.comp rcomputable.nat_unpaired) (rcomputable.fst.comp rcomputable.nat_unpaired) }⟩

def Join₂ (A B : set ℕ) := ⨁(λ n, if n = 0 then A else if n = 1 then B else {})

theorem le_Join₂_left (A B : set ℕ) [DA : decidable_pred A] [DB : decidable_pred B] : A ≤₁ Join₂ A B :=
@Join_one_one_reducible (λ n, if n = 0 then A else if n = 1 then B else {})
  (λ n a, by { cases n; simp, { exact DA a }, cases n; simp, { exact DB a }, { exact decidable.false } }) 0

theorem le_Join₂_right (A B : set ℕ) [DA : decidable_pred A] [DB : decidable_pred B] : B ≤₁ Join₂ A B :=
@Join_one_one_reducible (λ n, if n = 0 then A else if n = 1 then B else {})
  (λ n a, by { cases n; simp, { exact DA a }, cases n; simp, { exact DB a }, { exact decidable.false } }) 1

theorem Join₂_le  (A B C : set ℕ) [DA : decidable_pred A] [DB : decidable_pred B] [DC : decidable_pred C]
  (hA : A ≤ₜ C) (hB : B ≤ₜ C) : Join₂ A B ≤ₜ C :=
@Join_le (λ n, if n = 0 then A else if n = 1 then B else {})
  (λ n a, by { cases n; simp, { exact DA a }, cases n; simp, { exact DB a }, { exact decidable.false } })
  C DC (by { rcases hA with ⟨_, _, cA⟩, rcases hB with ⟨_, _, cB⟩,
    simp,
    suffices : (λ (x y : ℕ), if x = 0 then (to_bool (A y)) else if x = 1 then to_bool (B y) else ff) computable₂_in! λ x, to_bool (C x),
    exact this.of_eq (λ n m, by { cases n; simp, cases n; simp[has_emptyc.emptyc] }),
    refine rcomputable.ite (rcomputable.to_bool_eq ℕ rcomputable.fst (rcomputable.const 0)) _ _,
    exact cast (by { congr, funext x,
      exact (@bool.to_bool_eq (A x.snd) (A x.snd) (hA_w x.snd) (DA x.snd)).mpr (by refl),
      funext x, simp }) (cA.comp rcomputable.snd),
    refine rcomputable.ite (rcomputable.to_bool_eq ℕ rcomputable.fst (rcomputable.const 1)) _ (rcomputable.const ff),
    exact cast (by { congr, funext x,
      exact (@bool.to_bool_eq (B x.snd) (B x.snd) (hB_w x.snd) (DB x.snd)).mpr (by refl),
      funext x, simp }) (cB.comp rcomputable.snd) })

section classical
local attribute [instance, priority 0] classical.prop_decidable
open rpartrec

theorem cond_if_eq {α β} (p : set α) (x) (a b : β) :
  cond (chr p x) a b = if p x then a else b :=
by {by_cases h : p x; simp [h], simp [(chr_tt_iff p x).mpr h], simp [(chr_ff_iff p x).mpr h] }

def Jump (A : set ℕ) : set ℕ := {x | (⟦x.unpair.1⟧ₙ^(chr A) x.unpair.2).dom}

notation A`′`:1200 := Jump A

@[simp] def Jump_itr : ℕ → set ℕ → set ℕ
| 0     A := A
| (n+1) A := (Jump_itr n A)′

theorem lt_Jump (A : set ℕ) : A <ₜ A′ :=
⟨classical_iff.mpr
  begin
    show chr A computable_in! chr A′,
    have : ∃ e, ∀ x, (⟦e⟧ₙ^(chr A) x).dom ↔ A x,
    { have : ∃ e, ⟦e⟧ₙ^(chr A) = λ a, cond (chr A a) (some 0) none :=
        exists_index.mp (bool_to_part (chr A)),
      rcases this with ⟨e, he⟩,
      refine ⟨e, λ x, _⟩,
      show (⟦e⟧ₙ^(chr A) x).dom ↔ A x,
      simp [he],
      cases e : chr A x,
      simp[(chr_ff_iff _ _).1 e], rintros ⟨f, _⟩,
      simp[(chr_tt_iff _ _).1 e] },
    rcases this with ⟨e, he⟩,
    let f := λ x, chr A′ (e.mkpair x),
    have lmm_f : f computable_in! chr A′ :=
        (rcomputable.refl.comp (primrec₂.mkpair.comp (primrec.const e) primrec.id).to_rcomp),
    have : f = chr A,
    { funext x, simp[f, Jump, chr_ext, set.set_of_app_iff, he], },
    simp [←this], exact lmm_f,
  end,
  λ h : A′ ≤ₜ A,
  begin
    have l0 : chr A′ computable_in! chr A := classical_iff.mp h,
    have : ∃ e, ∀ x : ℕ, (⟦e⟧ₙ^(chr A) x).dom ↔ (x.mkpair x) ∉ A′,
    { let f : ℕ →. ℕ := (λ a, cond (chr A′ (a.mkpair a)) none (some 0)),
      have : f partrec_in! chr A :=
        ((rpartrec.cond (rpartrec.refl_in $ (chr A′ : ℕ →. bool))
        partrec.none.to_rpart (rcomputable.const 0)).comp
          (primrec₂.mkpair.comp primrec.id primrec.id).to_rcomp).trans l0,
      have : ∃ e, ⟦e⟧ₙ^(chr A) = f := exists_index.mp this,
      rcases this with ⟨e, he⟩,
      refine ⟨e, λ x, _⟩,
      simp[he, set.mem_def, f],
      cases e : chr A′ (x.mkpair x),
      simp[(chr_ff_iff _ _).1 e],
      simp[(chr_tt_iff _ _).1 e], rintros ⟨_, _⟩ },
    rcases this with ⟨e, he⟩,
    have : (e.mkpair e) ∉ A′ ↔ (e.mkpair e) ∈ A′,
    calc
      (e.mkpair e) ∉ A′ ↔ ¬(⟦e⟧ₙ^(chr A) e).dom : by simp[Jump]
                    ... ↔ (e.mkpair e) ∈ A′     : by simp[he],
    show false, from (not_iff_self _).mp this
  end⟩

theorem le_le_Jump {A B : set ℕ} : A ≤ₜ B → A′ ≤₁ B′ := λ h,
begin
  have h' := classical_iff.mp h,
  let f := (λ x : ℕ, ⟦x.unpair.1⟧ₙ^(chr A) x.unpair.2),
  have : ∃ e, ⟦e⟧ₙ^(chr B) = f,
  { have := (rpartrec.univ_tot ℕ ℕ (primrec.fst.comp primrec.unpair).to_rcomp h'
      (primrec.snd.comp primrec.unpair).to_rcomp),
    exact exists_index.mp this },
  rcases this with ⟨e, lmm_e⟩,
  have iff : ∀ x, A′ x ↔ B′ (e.mkpair x),
  { simp [Jump, lmm_e] },
  have pi : primrec e.mkpair := primrec₂.mkpair.comp (primrec.const e) (primrec.id),
  have inj : function.injective e.mkpair,
  { intros x y, intros h,
    have : x = (e.mkpair x).unpair.2, simp,
    rw this, rw h, simp },
  refine ⟨e.mkpair, pi.to_comp, inj, iff⟩,
end

theorem le_compl_of_le {A B : set ℕ} : A ≤₁ B → Aᶜ ≤₁ Bᶜ := λ ⟨f, comp, inj, h⟩,
⟨f, comp, inj, λ x, ⟨λ h₁ h₂, h₁ ((h x).mpr h₂), λ h₁ h₂, h₁ ((h x).mp h₂)⟩⟩

theorem le1_compl_iff {A B : set ℕ} : Aᶜ ≤₁ Bᶜ ↔ A ≤₁ B :=
⟨λ h, by { have := le_compl_of_le h, simp at this, exact this }, le_compl_of_le⟩

open primrec

lemma rre_pred_iff {p : set α} {f : β →. σ} :
  p re_in f ↔ ∃ q : ℕ →. ℕ, q partrec_in f ∧ (∀ x, p x ↔ (q $ encode x).dom) :=
begin
  split; assume h,
  { let q : ℕ →. ℕ :=
      λ n, part.bind (decode α n) (λ a, part.assert (p a) (λ (_ : p a), some 0)),
    have c : q partrec_in f :=
    (computable.decode.of_option.to_rpart).bind (h.comp rcomputable.snd),
    refine ⟨q, c, λ x, _⟩,
    simp [q, part.some, part.assert, encodek] },
  { rcases h with ⟨q, pq, hq⟩,
    let g : α →. unit := (λ x, (q (encode x)).map (λ x, ())),
    have : g partrec_in f :=
      (pq.comp computable.encode.to_rpart).map (rcomputable.const ()),
    exact (this.of_eq $ λ x, by {
      simp[g], apply part.ext, intros u, simp[hq, dom_iff_mem] }) }
end

lemma rre_pred_iff' {A : set α} {f : β →. σ} :
  A re_in f ↔ ∃ q : α →. ℕ, q partrec_in f ∧ (∀ x, A x ↔ (q x).dom) :=
begin
  split; assume h,
  { let q : α →. ℕ := (λ a, part.assert (A a) (λ (_ : A a), some 0)),
    refine ⟨q, h, λ x, _⟩,
    simp [q, part.some, part.assert, encodek] },
  { rcases h with ⟨q, pq, hq⟩,
    let g : α →. unit := (λ x, (q x).map (λ x, ())),
    have : g partrec_in f :=
      (pq.comp computable.encode.to_rpart).map (rcomputable.const ()),
    exact (this.of_eq $ λ x, by {
      simp[g], apply part.ext, intros u, simp[hq, dom_iff_mem] }) }
end

lemma rre_pred_iff_exists_index {A : set α} {f : β → σ} :
  A re_in! f ↔ ∃ e : ℕ, A = re_set α ℕ ↑ₒf e :=
⟨λ h, begin
    rcases rre_pred_iff'.mp h with ⟨q, partrec, h⟩,
    rcases exists_index.mp partrec with ⟨e, rfl⟩,
    refine ⟨e, set.ext h⟩
  end,
  by {rintros ⟨e, rfl⟩, refine rre_pred_iff'.mpr ⟨⟦e⟧^f, univ_partrec_in, λ x, by simp[re_set]⟩ }⟩

lemma rre_pred.rre {f : α →. σ} {g : β →. τ} {A : set γ} :
  A re_in f → f partrec_in g → A re_in g :=
by simp [rre_pred_iff]; exact λ q pq h pf, ⟨q, pq.trans pf, h⟩

lemma rre_pred.rre' {A : set α} {B : set β} {C : set γ} :
  A re_in! chr B → B ≤ₜ C → A re_in! chr C :=
by simp[classical_iff]; exact rre_pred.rre

theorem t_reducible.rre {A : set α} {B : set β} :
  A ≤ₜ B → A re_in! chr B := λ h,
begin
  have : (λ a, cond (chr A a) (some ()) none) partrec_in! chr B,
  { refine rpartrec.cond (classical_iff.mp h) (rcomputable.const _) rpartrec.none },
  exact (this.of_eq $ λ a,
    by { apply part.ext, simp, intros u, cases C : chr A a; simp at C ⊢; exact C })
end

theorem t_reducible.compl_rre {A : set α} {B : set β} :
  A ≤ₜ B → Aᶜ re_in! chr B := λ h,
begin
  have : (λ a, cond (chr A a) none (some ())) partrec_in! chr B,
  { refine rpartrec.cond (classical_iff.mp h) rpartrec.none (rcomputable.const _) },
  exact (this.of_eq $ λ a, by {
    apply part.ext, simp, intros u, cases C : chr A a; simp at C ⊢, exact C,
    exact not_not.mpr C })
end

theorem t_reducible_iff_rre {A : set α} {B : set β} :
  A ≤ₜ B ↔ A re_in! chr B ∧ Aᶜ re_in! chr B :=
⟨λ h, ⟨h.rre, h.compl_rre⟩, begin
  rintros ⟨h₁, h₂⟩, apply classical_iff.mpr,
  show chr A computable_in! chr B,
  rcases rre_pred_iff'.mp h₁ with ⟨χ, pA, hA⟩,
  rcases rre_pred_iff'.mp h₂ with ⟨χc, pAc, hAc⟩,
  rcases exists_index.mp pA with ⟨e₁, rfl⟩,
  rcases exists_index.mp pAc with ⟨e₂, rfl⟩,
  let f₀ : α → ℕ → option bool :=
    λ x s, ((⟦e₁⟧^(chr B) [s] x : option ℕ).map (λ _, tt)) <|> ((⟦e₂⟧^(chr B) [s] x : option ℕ).map (λ _, ff)),
  let f : α →. bool := λ x, nat.rfind_opt (f₀ x),
  have total : ∀ x, (f x).dom,
  { intros x, simp[f, f₀, nat.rfind_opt_dom], by_cases C : A x,
    { rcases univn_dom_complete.mp ((hA x).mp C) with ⟨n, h_n⟩,
      refine ⟨n, or.inr _⟩,
      rw ←option.some_get h_n, simp only [option.map, option.bind, option.some_orelse] },
    { rcases univn_dom_complete.mp ((hAc x).mp C) with ⟨n, h_n⟩, refine ⟨n, _⟩,
      rw ←option.some_get h_n,
      cases ⟦e₁⟧^(chr B) [n] x with v;
      simp only [option.map, option.bind, option.some_orelse, option.none_orelse], simp, right, refl } },
  let f' : α → bool := λ x, (f x).get (total x),
  have : chr A = f',
  { sorry },
  have mono : ∀ {x : α} {a} {m n : ℕ}, m ≤ n → a ∈ f₀ x m → a ∈ f₀ x n,
  { sorry },
  sorry
 end⟩

theorem rre_Jumpcomputable {A : set α} {B : set ℕ} : A re_in! chr B → A ≤ₜ B′ :=
λ h, classical_iff.mpr
begin
  show chr A computable_in! chr B′,
  rcases rre_pred_iff.mp h with ⟨a, pa, ha⟩,
  rcases exists_index.mp pa with ⟨e, he⟩,
  let f : α → bool := (λ x, chr B′ (e.mkpair (encode x))),
  have l0 : f computable_in (chr B′ : ℕ →. bool) :=
    rcomputable.refl.comp (primrec₂.mkpair.comp
      (primrec.const e) primrec.encode).to_rcomp,
  have l1 : f = chr A,
  { funext x, simp[f, Jump, chr_ext, set.set_of_app_iff, he, ha], },
  show chr A computable_in! chr B′, from (l0.of_eq $ by simp[l1])
end

theorem rre_iff_one_one_reducible {A B : set ℕ} : A re_in! chr B ↔ A ≤₁ B′ :=
⟨ begin
    assume h, show A ≤₁ B′,
    rcases rre_pred_iff.mp h with ⟨a, pa, ha⟩,
    rcases exists_index.mp pa with ⟨e, eqn_e⟩,
    have lmm1 : primrec e.mkpair := primrec₂.mkpair.comp (primrec.const _) primrec.id,
    have lmm2 : function.injective e.mkpair,
    { intros x y h,
      have : x = (e.mkpair x).unpair.2, simp,
      rw this, rw h, simp },
    have lmm3 : ∀ n, A n ↔ B′ (e.mkpair n),
    { simp[Jump, chr_ext, set.set_of_app_iff, eqn_e, ha], },
    refine ⟨e.mkpair, lmm1.to_comp, lmm2, lmm3⟩,
  end,
  begin
    assume h, show A re_in! chr B,
    rcases h with ⟨i, ci, inj, hi⟩,
    apply rre_pred_iff.mpr,
    let q : ℕ →. ℕ := (λ x, ⟦(i x).unpair.1⟧ₙ^(chr B) (i x).unpair.2),
    have lmm : q partrec_in! chr B,
    { refine rpartrec.univ_tot _ _
      (computable.fst.comp (primrec.unpair.to_comp.comp ci)).to_rcomp
      rcomputable.refl
      (computable.snd.comp (primrec.unpair.to_comp.comp ci)).to_rcomp },
    have lmm1 : ∀ n, A n ↔ (q n).dom,
    { intros x, simp [hi, q, Jump] },
    refine ⟨q, lmm, lmm1⟩,
  end⟩

theorem re_many_one_reducible_to_0' {A : set ℕ} : r.e. A ↔ A ≤₁ ∅′ :=
⟨λ h, rre_iff_one_one_reducible.mp (h.to_rpart),
 λ h, (rre_iff_one_one_reducible.mpr h).re0 ⟩

theorem re_pred_Jump_0 : r.e. ∅′ :=
re_many_one_reducible_to_0'.mpr (by refl)

lemma dom_rre (f : α →. σ) : {x | (f x).dom} re_in f :=
begin
  let g := (λ a, (f a).map (λ x, ())),
  have := rpartrec.refl.map ((computable.const ()).comp computable.snd).to_rcomp.to₂,
  exact (this.of_eq $ λ x, by { rw set.set_of_app_iff, simp,
    apply part.ext, intros a, simp [dom_iff_mem] })
end

theorem exists_rre [inhabited β] {p : α → β → Prop} {g : γ → τ} :
  {x : α × β | p x.1 x.2} re_in! g → {x | ∃ y, p x y} re_in! g := λ h,
begin
  have := rpartrec.exists_index.mp h,
  rcases this with ⟨e, eqn_e⟩,
  have eqn_e1 : ∀ x y, p x y ↔ (⟦e⟧^g (x, y) : part unit).dom,
  { simp [eqn_e, part.assert, part.some] },
  let p' := (λ x : α, nat.rfind (λ u, (⟦e⟧^g [u.unpair.2]
    (x, (decode β u.unpair.1).get_or_else (default β)) : option unit).is_some)),
  have lmm : ∀ x, (∃ y, p x y) ↔ (p' x).dom,
  { intros x, simp only [p'], split,
    { rintros ⟨y, hb⟩, rw eqn_e1 at hb,
      apply rfind_dom_total,
      simp [part.dom_iff_mem, part.some] at hb ⊢, rcases hb with ⟨z, hz⟩,
      rcases univn_complete.mp hz with ⟨s, hs⟩,
      use (encode y).mkpair s,
      simp [hs] },
    { simp, intros u h0 h1,
      use (decode β u.unpair.fst).get_or_else (default β),
      cases e : (⟦e⟧^g [u.unpair.snd] (x,
        (decode β u.unpair.fst).get_or_else (default β)) : option unit) with v,
      { exfalso, simp [e] at h0, exact h0 },
      have := univn_sound e, simp [eqn_e1, this] } },
  have eqn : {x | ∃ y, p x y} = {x | (p' x).dom},
  { apply set.ext, simp [lmm] },
  have : p' partrec_in! g,
  { apply rpartrec.rfind,
    refine primrec.option_is_some.to_rcomp.comp
      (rcomputable.univn_tot _ _
        (primrec.const _).to_rcomp
        rcomputable.refl (snd.comp $ primrec.unpair.comp snd).to_rcomp _),
    have := ((fst.pair (option_get_or_else.comp
      (primrec.decode.comp $ fst.comp $ unpair.comp snd)
      (const (default β))))), exact this.to_rcomp },
  rw eqn,
  show {x | (p' x).dom} re_in! g,
  from (dom_rre p').rre this
end

theorem rre_compl_of_rre {A B : set ℕ} :
  A re_in! chr B → Aᶜ re_in! chr B′ := λ h,
begin
  have lmm₁ : Aᶜ ≤₁ B′ᶜ,
  { simp[le1_compl_iff], exact rre_iff_one_one_reducible.mp h },
  have lmm₂ : B′ᶜ ≤₁ B′′, from rre_iff_one_one_reducible.mp (t_reducible.rre (reducible_compl B′)),
  exact rre_iff_one_one_reducible.mpr (lmm₁.trans lmm₂)
end

lemma rre_pred.rre_of_le {A : set α} {B : set β} {C : set γ} :
  A re_in! chr B → C ≤₀ A → C re_in! chr B := λ h ⟨f, comp, fh⟩,
begin
  rcases rre_pred_iff'.mp h with ⟨q, partrec, qh⟩,
  refine rre_pred_iff'.mpr ⟨q ∘ f, partrec.comp comp.to_rcomp, λ x, by simp[fh, qh]⟩,
end

theorem exists_reducible [inhabited β] {p : α → β → Prop} {A : set ℕ} :
  {x : α × β | p x.1 x.2} ≤ₜ A → {x | ∃ y, p x y} ≤ₜ A′ :=
λ h, rre_Jumpcomputable (exists_rre h.rre)

theorem forall_reducible [inhabited β] {p : α → β → Prop} {A : set ℕ} :
  {x : α × β | p x.1 x.2} ≤ₜ A → {x | ∀ y, p x y} ≤ₜ A′ := λ h,
begin
  have : {x | ∀ y, p x y}ᶜ ≤ₜ A′,
  { have : {x | ∃ y, ¬p x y} ≤ₜ A′,
    { apply exists_reducible,
      have := (equiv_compl {x : α × β | p x.1 x.2}).1.trans (h.of_eq $ by { intros a, simp }),
      exact (this.of_eq $ λ a, by refl) },
    exact (this.of_eq $ λ a, by { simp, exact not_forall.symm }) },
  apply (equiv_compl {x | ∀ y, p x y}).2.trans this
end

def Kleene (A : set ℕ) : set ℕ := {x | (⟦x⟧ₙ^(chr A) x).dom}

def Tot (A : set ℕ) : set ℕ := {e | ∀ x, (⟦e⟧ₙ^(chr A) x).dom}

def Unbound (A : set ℕ) : set ℕ := {e | ∀ x, ∃ y, x ≤ y ∧ (⟦e⟧ₙ^(chr A) y).dom}

def Rec (A : set ℕ) : set ℕ := {e | W⟦e⟧ₙ^(chr A) ≤ₜ A}

theorem Kleene_equiv_Jump (A : set ℕ) : Kleene A ≡ₜ A′ :=
⟨classical_iff.mpr
  begin
    show chr (Kleene A) computable_in! chr A′,
    let f := (λ n : ℕ, chr A′ (n.mkpair n)),
    have : chr (Kleene A) = f,
    { funext n, apply chr_ext.mpr,
      simp [Kleene, f, Jump] },
    rw this,
    have := rcomputable.refl.comp
      (primrec₂.mkpair.comp primrec.id primrec.id).to_rcomp,
    exact this
  end, classical_iff.mpr
  begin
    show chr A′ computable_in! chr (Kleene A),
    let t := (λ x : ℕ × (ℕ × ℕ), ⟦x.1⟧ₙ^(chr A) x.2.1),
    have : ∃ e, ⟦e⟧^(chr A) = t,
    { have : t partrec_in! chr A :=
        (rpartrec.univ_tot ℕ ℕ rcomputable.fst rcomputable.refl (fst.comp snd).to_rcomp),
      exact exists_index.mp this },
    rcases this with ⟨e, eqn_e⟩,
    let k := (λ n m : ℕ, curry (curry e n) m),
    have eqn_k : ∀ z i x, ⟦k i x⟧ₙ^(chr A) z = ⟦i⟧ₙ^(chr A) x,
    { intros z i x, simp [k, eqn_e] },
    let f := (λ x : ℕ, chr (Kleene A) (k x.unpair.1 x.unpair.2)),
    have : chr A′ = f,
    { funext n, apply chr_ext.mpr,
      simp [Kleene, f, Jump, eqn_k, eqn_e] },
    rw this,
    have : primrec₂ k := curry_prim.comp
      (curry_prim.comp (const e) fst) snd,
    have := rcomputable.refl.comp
      (this.comp (fst.comp primrec.unpair)
      (snd.comp primrec.unpair)).to_rcomp,
    exact this
  end⟩

theorem Tot_equiv_Jump2 (A : set ℕ) : Tot A ≤ₜ A′′ :=
begin
  have : Tot A = {e | ∀ x, ∃ s, (⟦e⟧ₙ^(chr A) [s] x).is_some},
  { simp[Tot, rpartrec.univn_dom_complete] },
  rw this,
  refine forall_reducible (exists_reducible $ classical_iff.mpr _),
  simp,
  refine option_is_some.to_rcomp.comp (rcomputable.univn_tot _ _
    (fst.comp fst).to_rcomp rcomputable.refl snd.to_rcomp (snd.comp fst).to_rcomp),
end

theorem Unbound_equiv_Jump2 (A : set ℕ) : Unbound A ≤ₜ A′′ :=
begin
  have : Unbound A = {e | ∀ x, ∃ y : ℕ × ℕ, x ≤ y.2 ∧ (⟦e⟧ₙ^(chr A) [y.1] y.2).is_some},
  { simp[Unbound, rpartrec.univn_dom_complete], funext n,
    simp, refine forall_congr (λ x, _), split,
    { rintros ⟨y, eqn, s, h⟩, refine ⟨s, y, eqn, h⟩ },
    { rintros ⟨s, y, eqn, h⟩, refine ⟨y, eqn, s, h⟩ } },
  rw this,
  refine forall_reducible (exists_reducible $ classical_iff.mpr _),
  let f := (λ x : (ℕ × ℕ) × ℕ × ℕ, to_bool (x.fst.snd ≤ x.snd.snd) &&
    (⟦x.fst.fst⟧ₙ^(chr A) [x.snd.fst] x.snd.snd).is_some),
  have : f computable_in! chr A,
  { refine (primrec.dom_bool₂ (&&)).to_rcomp.comp₂'
      (primrec₂.comp primrec.nat_le (snd.comp fst) (snd.comp snd)).to_rcomp
      (primrec.option_is_some.to_rcomp.comp (rcomputable.univn_tot _ _
        (fst.comp fst).to_rcomp rcomputable.refl (fst.comp snd).to_rcomp (snd.comp snd).to_rcomp)) },
  exact (this.of_eq $ λ x, by symmetry; simp[f, chr_iff])
end

theorem Rec_equiv_Jump3 (A : set ℕ) : Rec A ≤ₜ A′′′ :=
begin
  have : Rec A = {e : ℕ | ∃ i, ∀ x, ∃ s, (⟦i⟧ᵪ^(chr A) [s] x = some tt ↔ (⟦e⟧ₙ^(chr A) [s] x).is_some)},
  { simp[Rec, re_set], ext e, simp, sorry }, sorry
end

lemma rre_enumeration_iff {A : set α} {f : β → σ} (h : ∃ a, a ∈ A) :
  A re_in! f → (∃ e : ℕ → α, e computable_in! f ∧ (∀ x, x ∈ A ↔ ∃ n, e n = x)) :=
begin
  rcases h with ⟨a₀, hyp_a₀⟩,
  { intros hyp,
    rcases rre_pred_iff.mp hyp with ⟨q, hyp_q, hyp_q1⟩,
    let q' := (λ x : α, q (encode x)),
    have hyp_q' : q' partrec_in! f := hyp_q.comp primrec.encode.to_rcomp,
    rcases exists_index.mp hyp_q' with ⟨i, eqn_i⟩,
    let e := (λ n : ℕ, cond (⟦i⟧^f [n.unpair.1]
      ((decode α n.unpair.2).get_or_else a₀) : option ℕ).is_some
      ((decode α n.unpair.2).get_or_else a₀) a₀),
    have lmm1 : e computable_in! f,
    { refine rcomputable.cond
        (option_is_some.to_rcomp.comp (rcomputable.univn_tot _ _
          (rcomputable.const _)
          rcomputable.refl
          (fst.comp unpair).to_rcomp
          (option_get_or_else.comp (primrec.decode.comp $ snd.comp unpair) (const _)).to_rcomp))
        (option_get_or_else.comp (primrec.decode.comp $ snd.comp unpair)
          (const _)).to_rcomp (const _).to_rcomp },
    have lmm2 : ∀ x, x ∈ A ↔ ∃ n, e n = x,
    { simp [e], intros a, split,
      { intros hyp_a,
        have : ∃ y : ℕ, y ∈ (⟦i⟧^f a : part ℕ),
        { simp [←part.dom_iff_mem, eqn_i, q', ←hyp_q1], exact hyp_a },
        rcases this with ⟨y, lmm_y⟩,
        have := univn_complete.mp lmm_y, rcases this with ⟨s, lmm_s⟩,
        refine ⟨s.mkpair (encode a), _⟩, simp, simp[lmm_s] },
      { rintros ⟨n, hyp_n⟩,
        cases C : (⟦i⟧^f [n.unpair.fst] ((decode α n.unpair.snd).get_or_else a₀) : option ℕ) with v;
        simp[C] at hyp_n, simp[←hyp_n], exact hyp_a₀,
        suffices : (⟦i⟧^f a : part ℕ).dom,
        { simp[eqn_i, q', ←hyp_q1] at this, exact this },
        have := univn_sound C,
        simp[←hyp_n, this] } },
    refine ⟨e, lmm1, lmm2⟩ }
end

lemma re_enumeration_iff {A : set α} {f : β → σ} (h : ∃ a, a ∈ A) :
  r.e. A → ∃ e : ℕ → α, computable e ∧ (∀ x, x ∈ A ↔ ∃ n, e n = x) := λ hyp,
by { rcases rre_enumeration_iff h (hyp.to_rpart_in ↑ᵣ(@id ℕ)) with ⟨e, lmm1, lmm2⟩,
     refine ⟨e, rcomputable.le_comp_comp lmm1 computable.id, lmm2⟩ }

mutual def pie_pred, sigma_pred
with pie_pred : ℕ → set ℕ → Prop
| 0       A := computable_pred A
| (n + 1) A := ∃ B : set ℕ, sigma_pred n B ∧ A = {x | ∀ y, (x.mkpair y) ∈ B}
with sigma_pred : ℕ → set ℕ → Prop
| 0       A := computable_pred A
| (n + 1) A := ∃ B : set ℕ, pie_pred n B ∧ A = {x | ∃ y, (x.mkpair y) ∈ B}

prefix `𝚷⁰`:max := pie_pred

prefix `𝚺⁰`:max := sigma_pred

def delta_pred (n : ℕ) (A : set ℕ) : Prop := 𝚷⁰n A ∧ 𝚺⁰n A

prefix `𝚫⁰`:max := delta_pred

@[simp] lemma pie_pred0_iff {A : set ℕ} : 𝚷⁰0 A ↔ computable_pred A := by simp[pie_pred]

@[simp] lemma sigma_pred0_iff {A : set ℕ} : 𝚺⁰0 A ↔ computable_pred A := by simp[sigma_pred]

lemma pie_pred2_iff {A : set ℕ} {n : ℕ} :
  𝚷⁰(n + 2) A ↔ ∃ B : set ℕ, 𝚷⁰n B ∧ A = {x | ∀ y, ∃ z, (x.mkpair y).mkpair z ∈ B} :=
by { simp[sigma_pred, pie_pred], split,
     { rintros ⟨B₁, ⟨B₂, sigma, rfl⟩, rfl⟩, refine ⟨B₂, sigma, by refl⟩ },
     { rintros ⟨B₁, sigma, rfl⟩, refine ⟨_, ⟨B₁, sigma, rfl⟩, by refl⟩ } }

lemma sigma_pred2_iff {A : set ℕ} {n : ℕ} :
  𝚺⁰(n + 2) A ↔ ∃ B : set ℕ, 𝚺⁰n B ∧ A = {x | ∃ y, ∀ z, (x.mkpair y).mkpair z ∈ B} :=
by { simp[sigma_pred, pie_pred], split,
     { rintros ⟨B₁, ⟨B₂, sigma, rfl⟩, rfl⟩, refine ⟨B₂, sigma, by refl⟩ },
     { rintros ⟨B₁, sigma, rfl⟩, refine ⟨_, ⟨B₁, sigma, rfl⟩, by refl⟩ } }

lemma arith_hie_compl : ∀ {n : ℕ} {A : set ℕ},
  𝚷⁰n A ↔ 𝚺⁰n Aᶜ
| 0       A := by { simp[degree0'], exactI ⟨λ h, (equiv_compl A).trans h, λ h, (equiv_compl A).symm.trans h⟩ }
| (n + 1) A := by { simp[sigma_pred, pie_pred], split,
    { rintros ⟨B, sigma, rfl⟩,
      refine ⟨Bᶜ, (@arith_hie_compl n Bᶜ).mpr (by simp[sigma]), by simp[set.compl_set_of]⟩ },
    { rintros ⟨B, pie, eqn⟩,
      refine ⟨Bᶜ, (@arith_hie_compl n B).mp pie,
        by rw ←(compl_compl A); rw eqn; simp[set.compl_set_of]⟩ } }

lemma pie_pred.many_one : ∀ {n : ℕ} {A B : set ℕ} (pie : 𝚷⁰n B) (le : A ≤₀ B), 𝚷⁰n A
| 0       A B pie le := by { simp at*, exact le_computable_computable le.to_turing pie }
| 1       A B pie ⟨f, f_comp, le⟩ := by { simp[pie_pred] at pie,
    rcases pie with ⟨B', sigma, rfl⟩,
    let C : set ℕ := {x | (f x.unpair.1).mkpair x.unpair.2 ∈ B'},
    have : C ≤₀ B',
    { refine ⟨λ x, (f x.unpair.1).mkpair x.unpair.2, _, λ x, by simp[C]; refl⟩,
      refine primrec₂.mkpair.to_comp.comp (f_comp.comp (fst.comp unpair).to_comp) (snd.comp unpair).to_comp },
    have sigma' : computable_pred C, from le_computable_computable this.to_turing sigma,
    have : A = {x | ∀ y, x.mkpair y ∈ C}, { simp[C], exact set.ext le },
    simp [pie_pred], refine ⟨C, sigma', this⟩ }
| (n + 2) A B pie ⟨f, f_comp, le⟩ := by {
    rcases pie_pred2_iff.mp pie with ⟨B', pie', rfl⟩,
    let C : set ℕ := {x | ((f x.unpair.1.unpair.1).mkpair x.unpair.1.unpair.2).mkpair x.unpair.2 ∈ B'},
    have : C ≤₀ B',
    { refine ⟨λ x, ((f x.unpair.1.unpair.1).mkpair x.unpair.1.unpair.2).mkpair x.unpair.2,
        _, λ x, by simp[C]; refl⟩,
      refine primrec₂.mkpair.to_comp.comp
        (primrec₂.mkpair.to_comp.comp (f_comp.comp (fst.comp $ unpair.comp $ fst.comp unpair).to_comp)
        (snd.comp $ unpair.comp $ fst.comp unpair).to_comp) (snd.comp unpair).to_comp },
    have IH : 𝚷⁰n C, from pie_pred.many_one pie' this,
    have : A = {x | ∀ y, ∃ z, (x.mkpair y).mkpair z ∈ C},
    { simp[C], exact set.ext le },
    refine pie_pred2_iff.mpr ⟨C, IH, this⟩ }

lemma sigma_pred.many_one : ∀ {n : ℕ} {A B : set ℕ} (sigma : 𝚺⁰n B) (le : A ≤₀ B), 𝚺⁰n A
| 0       A B sigma le := by { simp at*, exact le_computable_computable le.to_turing sigma }
| 1       A B sigma ⟨f, f_comp, le⟩ := by { simp[sigma_pred] at sigma,
    rcases sigma with ⟨B', pie, rfl⟩,
    let C : set ℕ := {x | (f x.unpair.1).mkpair x.unpair.2 ∈ B'},
    have : C ≤₀ B',
    { refine ⟨λ x, (f x.unpair.1).mkpair x.unpair.2, _, λ x, by simp[C]; refl⟩,
      refine primrec₂.mkpair.to_comp.comp (f_comp.comp (fst.comp unpair).to_comp) (snd.comp unpair).to_comp },
    have pie' : computable_pred C, from le_computable_computable this.to_turing pie,
    have : A = {x | ∃ y, x.mkpair y ∈ C}, { simp[C], exact set.ext le },
    simp[sigma_pred], refine ⟨C, pie', this⟩ }
| (n + 2) A B sigma ⟨f, f_comp, le⟩ := by {
    rcases sigma_pred2_iff.mp sigma with ⟨B', sigma', rfl⟩,
    let C : set ℕ := {x | ((f x.unpair.1.unpair.1).mkpair x.unpair.1.unpair.2).mkpair x.unpair.2 ∈ B'},
    have : C ≤₀ B',
    { refine ⟨λ x, ((f x.unpair.1.unpair.1).mkpair x.unpair.1.unpair.2).mkpair x.unpair.2,
        _, λ x, by simp[C]; refl⟩,
      refine primrec₂.mkpair.to_comp.comp
        (primrec₂.mkpair.to_comp.comp (f_comp.comp (fst.comp $ unpair.comp $ fst.comp unpair).to_comp)
        (snd.comp $ unpair.comp $ fst.comp unpair).to_comp) (snd.comp unpair).to_comp },
    have IH : 𝚺⁰n C, from sigma_pred.many_one sigma' this,
    have : A = {x : ℕ | ∃ (y : ℕ), ∀ (z : ℕ), (x.mkpair y).mkpair z ∈ C},
    { simp[C], exact set.ext le },
    refine sigma_pred2_iff.mpr ⟨C, IH, this⟩ }

lemma pie_pred_iff {p : ℕ → ℕ → Prop} {n : ℕ}
  (h : 𝚺⁰n {x | p x.unpair.1 x.unpair.2}) : 𝚷⁰(n + 1) {x | ∀ y, p x y} :=
  by simp[pie_pred]; refine ⟨{x : ℕ | p (nat.unpair x).fst (nat.unpair x).snd}, h, by simp⟩

lemma sigma_pred_iff {p : ℕ → ℕ → Prop} {n : ℕ}
  (h : 𝚷⁰n {x | p x.unpair.1 x.unpair.2}) : 𝚺⁰(n + 1) {x | ∃ y, p x y} :=
  by simp[sigma_pred]; refine ⟨{x : ℕ | p (nat.unpair x).fst (nat.unpair x).snd}, h, by simp⟩

lemma pie_pred_bforall {p : ℕ → ℕ → Prop} {n : ℕ} {b : ℕ}
  (h : 𝚺⁰n {x | p x.unpair.1 x.unpair.2}) : 𝚺⁰n {x | ∀ y < b, p x y} :=
  by {  }

lemma sigma_pred.exists {n : ℕ} {A : set ℕ} (h : 𝚺⁰(n + 1) A) :
  𝚺⁰(n + 1) {x | ∃ y, (x.mkpair y) ∈ A} :=
begin
  simp[sigma_pred] at h ⊢,
  rcases (h) with ⟨B, pie, rfl⟩,
  simp,
  let B' : set ℕ := {x | (x.unpair.1.mkpair x.unpair.2.unpair.1).mkpair x.unpair.2.unpair.2 ∈ B},
  have eqn : {x : ℕ | ∃ y n, ((x.mkpair y).mkpair n) ∈ B} = {x | ∃ y : ℕ, (x.mkpair y) ∈ B' },
  { apply set.ext, intros x, simp[B'], split,
    { rintros ⟨y, n, mem⟩, refine ⟨y.mkpair n, _⟩, simp[mem] },
    { rintros ⟨y, mem⟩, refine ⟨y.unpair.1, y.unpair.2, mem⟩ } },
  have le : B' ≤₀ B,
  { refine ⟨λ x, (x.unpair.1.mkpair x.unpair.2.unpair.1).mkpair x.unpair.2.unpair.2, _, λ x, by simp[B']; refl⟩,
    refine (primrec₂.mkpair.comp
      (primrec₂.mkpair.comp (fst.comp unpair) $ fst.comp $ unpair.comp $ snd.comp unpair)
      (snd.comp $ unpair.comp $ snd.comp unpair)).to_comp },
  refine ⟨B', pie.many_one le, eqn⟩
end

lemma sigma_pred.exists' {n : ℕ} {p : ℕ → ℕ → Prop} (h : 𝚺⁰(n + 1) {x | p x.unpair.1 x.unpair.2}) :
  𝚺⁰(n + 1) {x | ∃ y, p x y} :=
by have := h.exists; simp at this; exact this

lemma sigma_pred.exists'' [inhabited α] {n : ℕ} {p : ℕ → α → Prop}
  (h : 𝚺⁰(n + 1) {x | p x.unpair.1 ((encodable.decode α x.unpair.2 ).get_or_else (default α))}) :
  𝚺⁰(n + 1) {x | ∃ y, p x y} :=
by { have := h.exists, simp at this, sorry }

lemma pie_pred.forall {n : ℕ} {A : set ℕ} (h : 𝚷⁰(n + 1) A) :
  𝚷⁰(n + 1) {x | ∀ y, (x.mkpair y) ∈ A} :=
by simp[arith_hie_compl, set.compl_set_of] at h ⊢; exact h.exists

lemma pie_pred.forall' {n : ℕ} {p : ℕ → ℕ → Prop} (h : 𝚷⁰(n + 1) {x | p x.unpair.1 x.unpair.2}) :
  𝚷⁰(n + 1) {x | ∀ y, p x y} :=
by have := h.forall; simp at this; exact this

lemma sigma_pred1_iff_re {A : set ℕ} : 𝚺⁰1 A ↔ r.e. A :=
begin
  simp[sigma_pred, ←rre_in_0_iff_re], split,
  { rintros ⟨B, comp, rfl⟩, refine exists_rre (t_reducible.rre _),
    have : {x : ℕ × ℕ | x.1.mkpair x.2 ∈ B} ≤ₜ B,
      from classical_iff.mpr (rcomputable.refl.comp (primrec₂.mkpair.comp fst snd).to_rcomp),
    exact this.trans ((degree0' B).mp comp).1 },
  { intros h,
    rcases rre_pred_iff_exists_index.mp h with ⟨e, rfl⟩,
    let B : set ℕ := {x | (⟦e⟧ₙ^(chr ∅ : ℕ → bool) [x.unpair.2] x.unpair.1).is_some},
    have lmm₁ : computable_pred B,
    { refine computable_pred_iff_le.mpr (classical_iff.mpr _),
      have : (λ x : ℕ, (⟦e⟧ₙ^(chr ∅ : ℕ → bool) [x.unpair.2] x.unpair.1).is_some) computable_in! chr (∅ : set ℕ),
        from primrec.option_is_some.to_rcomp.comp
          (rcomputable.univn_tot _ _ (rcomputable.const _) rcomputable.refl (snd.comp unpair).to_rcomp (fst.comp unpair).to_rcomp ),
      exact this.of_eq (λ x, by simp[B]) },
    have lmm₂ : W⟦e⟧ₙ^(chr (∅ : set ℕ)) = {x | ∃ y, x.mkpair y ∈ B},
    { refine set.ext (λ x, _), simp[B], exact univn_dom_complete },
    exact ⟨B, lmm₁, lmm₂⟩ }
end

lemma pie_pred1_iff_co_re {A : set ℕ} : 𝚷⁰1 A ↔ r.e. Aᶜ :=
by simp[arith_hie_compl, sigma_pred1_iff_re]

lemma sigma_Jump_of_pie {n : ℕ} {A : set ℕ} (sigma : 𝚺⁰ n A) : 𝚺⁰ (n + 1) A′ :=
begin
  simp[Jump], sorry
end

theorem sigma_complete : ∀ {n : ℕ} {A : set ℕ},
  𝚺⁰(n + 1) A ↔ A re_in! chr (Jump_itr n ∅)
| 0       A := by simp[rre_in_0_iff_re]; exact sigma_pred1_iff_re
| (n + 1) A := begin
    have IH_sigma : ∀ {A}, 𝚺⁰(n + 1) A ↔ A re_in! chr (Jump_itr n ∅), from @sigma_complete n,
    have IH_pie : ∀ {A}, 𝚷⁰(n + 1) A ↔ Aᶜ re_in! chr (Jump_itr n ∅),
    { intros A, simp[arith_hie_compl, IH_sigma] },
    split,
    { simp[sigma_pred], rintros B pie rfl, refine exists_rre _,
      have lmm₁ : B re_in! chr (Jump_itr n ∅)′,
      { have := rre_compl_of_rre (IH_pie.mp pie), simp at this, exact this },
      have lmm₂ : {x : ℕ × ℕ | nat.mkpair x.fst x.snd ∈ B} ≤₀ B,
        from ⟨λ x, nat.mkpair x.fst x.snd, (primrec₂.mkpair.comp fst snd).to_comp, by simp[set.mem_def]⟩,
      exact rre_pred.rre_of_le lmm₁ lmm₂ },
    { intros h, simp at h,
      have : 𝚺⁰(n + 1) (Jump_itr n ∅)′, from IH_sigma.mpr (rre_iff_one_one_reducible.mpr (by refl)),
      refine (sigma_Jump_of_pie this).many_one (rre_iff_one_one_reducible.mp h).to_many_one }
  end

lemma computable_pred_iff_chr_computable {A : set ℕ} : computable_pred A ↔ computable (chr A) :=
begin
  simp[computable_pred_iff_le, classical_iff],
  split; intros h, { refine rcomputable.le_comp_comp h ((computable.const ff).of_eq (by { simp[has_emptyc.emptyc] })), },
  { exact h.to_rcomp }
end

lemma re_Join_of_re_re {A B : set ℕ} (hA : r.e. A) (hB : r.e. B) : r.e. Join₂ A B :=
begin
  simp[Join₂, Join, ←sigma_pred1_iff_re, sigma_pred, computable_pred_iff_chr_computable] at *,
  rcases hA with ⟨A, hA, rfl⟩,
  rcases hB with ⟨B, hB, rfl⟩,
  let C : set ℕ := {n : ℕ |
    if (nat.unpair n).1.unpair.2 = 0 then nat.mkpair n.unpair.1.unpair.1 n.unpair.2 ∈ A else
    if (nat.unpair n).1.unpair.2 = 1 then nat.mkpair n.unpair.1.unpair.1 n.unpair.2 ∈ B else false },
  refine ⟨C, by { simp[C],
    suffices :
      computable
      (λ n, if (nat.unpair n).1.unpair.2 = 0 then chr A (nat.mkpair n.unpair.1.unpair.1 n.unpair.2) else
            if (nat.unpair n).1.unpair.2 = 1 then chr B (nat.mkpair n.unpair.1.unpair.1 n.unpair.2) else ff),
    exact this.of_eq (λ n, by { by_cases C₁ : (nat.unpair (nat.unpair n).fst).snd = 0; simp[C₁, set.mem_def, chr_eq_to_bool],
      by_cases C₂ : (nat.unpair (nat.unpair n).fst).snd = 1; simp[C₂] }),
    refine rcomputable.computable_of_rcomp (rcomputable.ite
      (rcomputable.to_bool_eq ℕ
        (rcomputable.snd.comp (rcomputable.nat_unpaired.comp (rcomputable.fst.comp rcomputable.nat_unpaired)))
        (rcomputable.const 0))
      (hA.to_rcomp.comp (rcomputable₂.comp rpartrec.some
        (rcomputable.fst.comp (rcomputable.nat_unpaired.comp (rcomputable.fst.comp rcomputable.nat_unpaired)))
        (rcomputable.snd.comp rcomputable.nat_unpaired))) _),
    refine rcomputable.ite
      (rcomputable.to_bool_eq ℕ
        (rcomputable.snd.comp (rcomputable.nat_unpaired.comp (rcomputable.fst.comp rcomputable.nat_unpaired)))
        (rcomputable.const 1)) (hB.to_rcomp.comp
      (rcomputable₂.comp rpartrec.some
        (rcomputable.fst.comp (rcomputable.nat_unpaired.comp (rcomputable.fst.comp rcomputable.nat_unpaired)))
        (rcomputable.snd.comp rcomputable.nat_unpaired))) (rcomputable.const ff) },
  by { ext x, simp, cases (nat.unpair x).snd with n; simp,
    { cases n with n; simp }}⟩,
end

end classical


import model_theory.substructures
import model_theory.bundled

--OUTPUT 1
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let A : ℕ → L.Theory,
  have h1 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h2 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h3 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h4 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h5 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h6 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h7 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h8 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h9 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h10 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h11 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h12 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h13 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h14 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h15 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h16 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h17 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h18 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h19 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h20 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h21 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h22 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h23 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h24 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h25 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h26 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h27 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h28 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h29 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h30 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h31 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h32 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h33 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h34 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h35 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h36 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h37 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h38 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h39 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h40 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h41 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h42 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h43 : ∀ n :
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Overflow theorem
Let $F$ be a set of first-order formulas which has finite models of arbitrarily large size. Then $F$ has an infinite model.
`proof`
For each $n$, let $\mathbf A_n$ be the formula:

$\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$

Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.

Take:
$$ \Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i $$

Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.

From the Compactness Theorem, $\Gamma$ is satisfiable in some model $\mathbf{M}$.

But since $\mathbf{M} \models A_i$ for each $i$, $\mathbf{M}$ must be infinite.

So $F$ has an infinite model.

QED
-/
theorem  overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
FEW SHOT PROMPTS TO CODEX(END)-/


import for_mathlib.category_theory.triangulated.pretriangulated_misc
import algebra.homology.short_complex.exact
import for_mathlib.category_theory.localization.triangulated_subcategory
import for_mathlib.category_theory.shift_misc
import for_mathlib.category_theory.preadditive.misc
import category_theory.limits.preserves.shapes.zero
import for_mathlib.category_theory.shift_compatibility_minus

noncomputable theory

namespace category_theory

open limits category pretriangulated
open_locale zero_object

lemma limits.exists_discrete_walking_pair_exists_iso_pair
  {C : Type*} [category C] (F : discrete walking_pair ⥤ C) :
  ∃ (X₁ X₂ : C), nonempty (F ≅ pair X₁ X₂) :=
⟨F.obj (discrete.mk walking_pair.left), F.obj (discrete.mk walking_pair.right),
  ⟨discrete.nat_iso_functor ≪≫ eq_to_iso (by { congr' 1, ext j, cases j, tidy, })⟩⟩

section

variables {C D : Type*} [category C] [category D] [has_zero_morphisms C] [has_zero_morphisms D]

instance preserves_limit_functor_empty (F : C ⥤ D) [F.preserves_zero_morphisms]
  [has_zero_object C] : preserves_limit (functor.empty.{0} C) F :=
begin
  let c : cone (functor.empty.{0} C) := cone.mk 0 { app := λ X, 0, },
  have hc : is_limit c :=
  { lift := λ s, 0,
    fac' := by rintro s ⟨⟨⟩⟩,
    uniq' := λ s m hm, subsingleton.elim _ _, },
  refine preserves_limit_of_preserves_limit_cone hc
  { lift := λ s, 0,
    fac' := by rintro s ⟨⟨⟩⟩,
    uniq' := λ s m hm, begin
      refine is_zero.eq_of_tgt _ _ _,
      dsimp [functor.map_cone],
      rw [limits.is_zero.iff_id_eq_zero, ← F.map_id,
        subsingleton.elim (𝟙 (0 : C)) 0, F.map_zero],
    end, },
end

end

section
/-- should be moved to short_complex.exact -/

variables {C : Type*} [category C]

lemma short_complex.exact.is_zero_of_both_zeros [has_zero_morphisms C]
  {S : short_complex C} (ex : S.exact)
  (h₁ : S.f = 0) (h₂ : S.g = 0) : is_zero S.X₂ :=
(short_complex.homology_data.of_zeros S h₁ h₂).exact_iff.1 ex

lemma short_complex.exact.epi_f_iff_g_eq_zero [preadditive C] {S : short_complex C}
  (ex : S.exact) : epi S.f ↔ S.g = 0 :=
begin
  split,
  { introI,
    simp only [← cancel_epi S.f, S.zero, comp_zero], },
  { intro hg,
    haveI := ex.has_homology,
    haveI := S.is_iso_cycles_i_of hg,
    rw preadditive.epi_iff_cancel_zero,
    intros Z h eq,
    rw [← S.p_desc_cycles_co _ eq, ← cancel_epi (S.cycles_i),
      reassoc_of (S.exact_iff_cycles_i_p_cycles_co_zero.1 ex), comp_zero, zero_comp], },
end

lemma short_complex.exact.mono_g_iff_f_eq_zero [preadditive C] {S : short_complex C}
  (ex : S.exact) : mono S.g ↔ S.f = 0 :=
begin
  split,
  { introI,
    simp only [← cancel_mono S.g, S.zero, zero_comp], },
  { intro hf,
    haveI := ex.has_homology,
    haveI := S.is_iso_p_cycles_co_of hf,
    rw preadditive.mono_iff_cancel_zero,
    intros Z h eq,
    rw [← S.lift_cycles_i _ eq, ← cancel_mono (S.p_cycles_co), assoc,
      S.exact_iff_cycles_i_p_cycles_co_zero.1 ex, comp_zero, zero_comp], },
end

end

variables {C D A : Type*} [category C] [has_zero_object C] [has_shift C ℤ]
  [preadditive C] [∀ (n : ℤ), (shift_functor C n).additive] [pretriangulated C]
  [category D] [has_zero_object D] [has_shift D ℤ]
  [preadditive D] [∀ (n : ℤ), (shift_functor D n).additive] [pretriangulated D]
  [category A] [abelian A] (F : C ⥤ A) [functor.preserves_zero_morphisms F]

@[simps]
def pretriangulated.triangle.short_complex (T : pretriangulated.triangle C)
  (hT : T ∈ dist_triang C) : short_complex C :=
  (candidate_triangle.of_distinguished T hT).short_complex

namespace functor

@[protected]
class is_homological : Prop :=
(map_distinguished [] : ∀ (T : pretriangulated.triangle C) (hT : T ∈ dist_triang C),
  ((T.short_complex hT).map F).exact)

namespace is_homological

lemma mk' (hF : ∀ (T : pretriangulated.triangle C) (hT : T ∈ dist_triang C),
  ∃ (T' : pretriangulated.triangle C) (hT' : T' ∈ dist_triang C) (e : T ≅ T'),
    ((T'.short_complex hT').map F).exact) :
  F.is_homological :=
⟨λ T hT, begin
  obtain ⟨T', hT', e, ex'⟩ := hF T hT,
  refine (short_complex.exact_iff_of_iso (F.map_short_complex.map_iso
    ((candidate_triangle.to_short_complex_functor C).map_iso _))).2 ex',
  exact preimage_iso (full_subcategory_inclusion _ : candidate_triangle C ⥤ _) e,
end⟩

variable {F}

lemma of_iso {G : C ⥤ A} [G.preserves_zero_morphisms] (e : G ≅ F) [F.is_homological] :
  G.is_homological :=
is_homological.mk (λ T hT, (short_complex.exact_iff_of_iso
  (short_complex.map_nat_iso _ e)).2 (is_homological.map_distinguished F T hT))

end is_homological

section

open triangulated

variable [F.is_homological]

def kernel_of_is_homological : set C :=
λ K, ∀ (n : ℤ), limits.is_zero (F.obj (K⟦n⟧))

instance : is_triangulated_subcategory F.kernel_of_is_homological :=
{ zero := λ n, limits.is_zero.of_iso (is_zero_zero A)
    (F.map_iso (shift_functor C n).map_zero_object ≪≫ F.map_zero_object),
  shift := λ K m hK n, limits.is_zero.of_iso (hK (m+n))
    (F.map_iso ((shift_functor_add C m n).app K).symm),
  ext₂ := λ T hT h₁ h₃ n, (is_homological.map_distinguished F _
    (triangle.shift_distinguished _ T hT n)).is_zero_of_both_zeros
    (is_zero.eq_of_src (h₁ _) _ _) (is_zero.eq_of_tgt (h₃ _) _ _), }

instance kernel_of_is_homological_saturated :
  saturated F.kernel_of_is_homological :=
⟨λ L K i, begin
  introI,
  intros hL n,
  replace hL := hL n,
  rw limits.is_zero.iff_id_eq_zero at ⊢ hL,
  have eq : 𝟙 _ = i ≫ 𝟙 _ ≫ retraction i := by simp only [id_comp, is_split_mono.id],
  replace eq := (shift_functor C n ⋙ F).congr_map eq,
  dsimp only [functor.comp_map] at eq,
  simpa only [functor.map_comp, functor.map_id, hL, zero_comp, comp_zero] using eq,
end⟩

def W_of_is_homological : morphism_property C :=
λ X Y f, ∀ (n : ℤ), is_iso (F.map (f⟦n⟧'))

instance : preserves_limits_of_shape (discrete walking_pair) F :=
begin
  suffices : ∀ (X₁ X₂ : C), preserves_limit (pair X₁ X₂) F,
  { haveI := this,
    exact ⟨λ X, preserves_limit_of_iso_diagram F
      (category_theory.limits.exists_discrete_walking_pair_exists_iso_pair X)
      .some_spec.some_spec.some.symm⟩, },
  intros X₁ X₂,
  haveI : mono (F.biprod_comparison X₁ X₂),
  { rw preadditive.mono_iff_cancel_zero,
    intros Z f hf,
    have h₂ : f ≫ F.map biprod.snd = 0,
    { simpa only [assoc, biprod_comparison_snd, zero_comp] using hf =≫ biprod.snd, },
    have ex := is_homological.map_distinguished F _
      (binary_biproduct_triangle_distinguished X₁ X₂),
    let S := short_complex.mk (F.map (biprod.inl : X₁ ⟶ _)) (F.map (biprod.snd : _ ⟶ X₂))
      (by { rw ← F.map_comp, simp only [biprod.inl_snd, functor.map_zero]}),
    have ex : S.short_exact := short_complex.short_exact.mk
      (is_homological.map_distinguished F _ (binary_biproduct_triangle_distinguished X₁ X₂)),
    have hf' : ∃ (f₁ : Z ⟶ F.obj X₁), f₁ ≫ F.map biprod.inl = f := ⟨_, ex.lift_f f h₂⟩,
    obtain ⟨f₁, rfl⟩ := hf',
    replace hf := hf =≫ biprod.fst,
    simp only [assoc, biprod_comparison_fst, zero_comp, ← F.map_comp,
      biprod.inl_fst, F.map_id, comp_id] at hf,
    rw [hf, zero_comp], },
  haveI : preserves_binary_biproduct X₁ X₂ F :=
    limits.preserves_binary_biproduct_of_mono_biprod_comparison F,
  apply limits.preserves_binary_product_of_preserves_binary_biproduct,
end

@[priority 100]
instance is_homological.additive : F.additive :=
functor.additive_of_preserves_binary_products _

lemma kernel_of_is_homological_W :
  triangulated.subcategory.W F.kernel_of_is_homological = F.W_of_is_homological :=
begin
  ext X Y f,
  split,
  { intros hf n,
    let f' := f⟦n⟧',
    change is_iso (F.map f'),
    have hf' : triangulated.subcategory.W F.kernel_of_is_homological f' :=
      (morphism_property.compatible_with_shift.iff _ f n).2 hf,
    obtain ⟨Z, g', h', dist, mem⟩ := hf',
    rw is_iso_iff_mono_and_epi,
    split,
    { exact (functor.is_homological.map_distinguished F _
        (inv_rot_of_dist_triangle _ _ dist)).mono_g_iff_f_eq_zero.2
        (limits.is_zero.eq_of_src (mem (-1)) _ _), },
    { exact (functor.is_homological.map_distinguished F _ dist).epi_f_iff_g_eq_zero.2
        (limits.is_zero.eq_of_tgt
          (limits.is_zero.of_iso (mem 0) (F.map_iso ((shift_functor_zero C ℤ).symm.app _))) _ _), }, },
  { intro hf,
    obtain ⟨Z, g, h, mem⟩ := pretriangulated.distinguished_cocone_triangle _ _ f,
    have w : f ≫ g = 0 := pretriangulated.triangle.comp_zero₁₂ _ mem,
    refine ⟨Z, g, h, mem, λ n, _⟩,
    refine short_complex.exact.is_zero_of_both_zeros
      (functor.is_homological.map_distinguished F _
        (rot_of_dist_triangle _ _ (triangle.shift_distinguished _ _ mem n))) _ _,
    { dsimp [pretriangulated.triangle.short_complex],
      haveI := hf n,
      rw ← cancel_epi (F.map (f⟦n⟧')),
      simp only [F.map_zsmul, comp_zero, preadditive.comp_zsmul, ← functor.map_comp, w,
        functor.map_zero, zsmul_zero], },
    { haveI : is_iso (F.map (f⟦n⟧'⟦(1 : ℤ)⟧')) :=
        (nat_iso.is_iso_map_iff (iso_whisker_right (shift_functor_add _ n 1) F) f).1 (hf (n+1)),
      rw ← cancel_mono (F.map (f⟦n⟧'⟦(1 : ℤ)⟧')),
      have w' := F.congr_map (pretriangulated.triangle.comp_zero₂₃ _
        (rot_of_dist_triangle _ _ (triangle.shift_distinguished _ _ mem n))),
      dsimp [pretriangulated.triangle.short_complex] at ⊢ w',
      simp only [preadditive.comp_neg, functor.map_zsmul, assoc, preadditive.comp_zsmul,
        preadditive.zsmul_comp, functor.map_neg, F.map_zero, smul_neg, neg_eq_zero,
        smul_smul, ← units.coe_mul, ← mul_zpow, mul_neg, neg_mul, neg_neg, one_mul, one_smul,
        one_zpow, units.coe_one] at w',
      simp only [← F.map_comp, zero_comp, assoc, preadditive.zsmul_comp, F.map_zsmul, w',
        smul_zero], }, },
end

instance shift_is_homological (n : ℤ) :
  (shift_functor C n ⋙ F).is_homological :=
⟨λ T hT, begin
  refine (short_complex.exact_iff_of_iso _).1
    (functor.is_homological.map_distinguished F _ (triangle.shift_distinguished _ _ hT n)),
  refine short_complex.mk_iso (preadditive.mul_iso ((-1 : units ℤ)^n) (iso.refl _))
    (iso.refl _) (preadditive.mul_iso ((-1 : units ℤ)^n) (iso.refl _)) _ _,
  { dsimp, simp only [preadditive.zsmul_comp, id_comp, comp_id, F.map_zsmul], },
  { dsimp, simp only [preadditive.comp_zsmul, id_comp, comp_id, F.map_zsmul, smul_smul,
      ← units.coe_mul, ← mul_zpow, mul_neg, neg_mul, neg_neg, one_mul, one_smul, one_zpow,
      units.coe_one], },
end⟩

end

@[priority 100]
instance triangulated_functor_preserves_zero_morphisms
  (F : C ⥤ D) [F.has_comm_shift ℤ] [F.is_triangulated] :
  F.preserves_zero_morphisms :=
⟨λ X₁ X₂, begin
  have h := triangle.comp_zero₁₂ _ (F.map_distinguished _
    (binary_product_triangle_distinguished X₁ X₂)),
  dsimp at h,
  simpa only [← F.map_comp, prod.lift_snd] using h,
end⟩

instance triangulated_functor_preserves_binary_products
  (F : C ⥤ D) [F.has_comm_shift ℤ] [F.is_triangulated] :
  preserves_limits_of_shape (discrete walking_pair) F :=
begin
  suffices : ∀ (X₁ X₂ : C), preserves_limit (pair X₁ X₂) F,
  { haveI := this,
    exact ⟨λ X, preserves_limit_of_iso_diagram F
      (category_theory.limits.exists_discrete_walking_pair_exists_iso_pair X)
      .some_spec.some_spec.some.symm⟩, },
  intros X₁ X₂,
  haveI : mono (F.biprod_comparison X₁ X₂),
  { rw preadditive.mono_iff_cancel_zero,
    intros Z f hf,
    have h₂ : f ≫ F.map biprod.snd = 0,
    { simpa only [assoc, biprod_comparison_snd, zero_comp] using hf =≫ biprod.snd, },
    obtain ⟨f₁, rfl⟩ := covariant_yoneda_exact₂ _
      (F.map_distinguished _ (binary_biproduct_triangle_distinguished X₁ X₂)) f h₂,
    replace hf := hf =≫ biprod.fst,
    dsimp [triangulated_functor.map_triangle] at hf,
    simp only [assoc, biprod_comparison_fst, zero_comp, ← F.map_comp, biprod.inl_fst,
      F.map_id, comp_id] at hf,
    rw [hf, zero_comp], },
  haveI : preserves_binary_biproduct X₁ X₂ F :=
    limits.preserves_binary_biproduct_of_mono_biprod_comparison _,
  apply limits.preserves_binary_product_of_preserves_binary_biproduct,
end

@[priority 100]
instance triangulated_functor_additive (F : C ⥤ D) [F.has_comm_shift ℤ] [F.is_triangulated ] :
  F.additive :=
functor.additive_of_preserves_binary_products _

@[priority 100]
instance is_homological.of_comp (F : C ⥤ D) (G : D ⥤ A) [F.has_comm_shift ℤ]
  [F.is_triangulated] [G.preserves_zero_morphisms]
  [G.is_homological] : (F ⋙ G).is_homological :=
⟨λ T hT, begin
  have h := is_homological.map_distinguished G _ (F.map_distinguished _ hT),
  exact h,
end⟩

namespace is_homological

variables (F) (T : pretriangulated.triangle C) (hT : T ∈ dist_triang C)
  (n₀ n₁ : ℤ) (h : n₁ = n₀+1)

include h

def δ : F.obj (T.obj₃⟦n₀⟧) ⟶ F.obj (T.obj₁⟦n₁⟧) :=
F.map (T.mor₃⟦n₀⟧' ≫ (shift_functor_add' C (1 : ℤ) n₀ n₁ (by rw [h, add_comm])).inv.app T.obj₁)

omit h

include hT

lemma δ_comp : δ F T n₀ n₁ h ≫ F.map (T.mor₁⟦n₁⟧') = 0 :=
begin
  dsimp only [δ],
  rw [← F.map_comp, assoc, ← nat_trans.naturality],
  erw [← functor.map_comp_assoc, pretriangulated.triangle.comp_zero₃₁ _ hT],
  simp only [functor.map_zero, zero_comp],
end

lemma comp_δ : F.map (T.mor₂⟦n₀⟧') ≫ δ F T n₀ n₁ h  = 0 :=
begin
  dsimp only [δ],
  rw [← F.map_comp, ← functor.map_comp_assoc, pretriangulated.triangle.comp_zero₂₃ _ hT],
  simp only [functor.map_zero, zero_comp],
end

variable [hF : F.is_homological]

include hF

lemma ex₂ (n : ℤ) :
  (short_complex.mk (F.map (T.mor₁⟦n⟧')) (F.map (T.mor₂⟦n⟧'))
    (by rw [← F.map_comp, ← functor.map_comp, pretriangulated.triangle.comp_zero₁₂ _ hT,
      functor.map_zero, F.map_zero])).exact :=
begin
  refine (short_complex.exact_iff_of_iso _).1
    (is_homological.map_distinguished F _ (pretriangulated.triangle.shift_distinguished C T hT n)),
  refine short_complex.mk_iso (iso.refl _) (preadditive.mul_iso ((-1 : units ℤ)^n) (iso.refl _))
    (iso.refl _) _ _,
  { dsimp,
    simp only [id_comp, linear.comp_smul, comp_id, F.map_zsmul, smul_smul,
      int.units_coe_mul_self, one_zsmul], },
  { dsimp,
    simp only [linear.smul_comp, id_comp, comp_id, F.map_zsmul], },
end

lemma ex₃ :
  (short_complex.mk (F.map (T.mor₂⟦n₀⟧')) (δ F T n₀ n₁ h) (comp_δ F T hT n₀ n₁ h)).exact :=
begin
  refine (short_complex.exact_iff_of_iso _).1
    (is_homological.map_distinguished F _ ((rotate_distinguished_triangle _).1
      (pretriangulated.triangle.shift_distinguished C T hT n₀))),
  refine short_complex.mk_iso (iso.refl _) (preadditive.mul_iso ((-1 : units ℤ)^n₀) (iso.refl _))
    (F.map_iso ((shift_functor_add' C n₀ (1 : ℤ) n₁ h).symm.app T.obj₁)) _ _,
  { dsimp,
    simp only [id_comp, comp_id, F.map_zsmul, preadditive.comp_zsmul, smul_smul,
      int.units_coe_mul_self, one_zsmul], },
  { dsimp [δ],
    simp only [preadditive.zsmul_comp, id_comp, F.map_zsmul, ← F.map_comp, assoc],
    congr' 3,
    simp only [shift_functor_add_comm_hom_app],
    dsimp only [shift_functor_add', eq_to_iso, iso.trans],
    simp only [nat_trans.comp_app, eq_to_hom_app, assoc,
      iso.hom_inv_id_app_assoc, eq_to_hom_trans], },
end

lemma ex₁ :
  (short_complex.mk (δ F T n₀ n₁ h) (F.map (T.mor₁⟦n₁⟧')) (δ_comp F T hT n₀ n₁ h)).exact :=
begin
  refine (short_complex.exact_iff_of_iso _).1
    (is_homological.map_distinguished F _ ((inv_rotate_distinguished_triangle _).2
      (pretriangulated.triangle.shift_distinguished C T hT n₁))),
  refine short_complex.mk_iso
    (F.map_iso ((shift_functor_add' C n₁ (-1) n₀
      (by rw [h, int.add_neg_one, add_tsub_cancel_right])).symm.app T.obj₃))
    (preadditive.mul_iso ((-1 : units ℤ)^n₀) (iso.refl _))
    (preadditive.mul_iso ((-1 : units ℤ)) (iso.refl _)) _ _,
  { change F.map ((shift_functor_add' C n₁ (-1 : ℤ) n₀ _).inv.app T.obj₃) ≫
      F.map (T.mor₃⟦n₀⟧' ≫ (shift_functor_add' C 1 n₀ n₁ _).inv.app T.obj₁) =
      F.map (-(shift_functor C (-1 : ℤ)).map (((-1 : units ℤ)^n₁ • T.mor₃⟦n₁⟧') ≫ (shift_functor_add_comm C 1 n₁).hom.app _) ≫
      (shift_shift_neg (T.obj₁⟦n₁⟧) (1 : ℤ)).hom) ≫ ((-1 : units ℤ)^n₀ • 𝟙 _),
    rw functor.map_neg,
    erw preadditive.zsmul_comp,
    erw preadditive.comp_zsmul,
    rw functor.map_zsmul,
    rw preadditive.zsmul_comp,
    rw functor.map_zsmul,
    rw comp_id,
    rw smul_neg,
    rw smul_smul,
    simp only [h, zpow_add, zpow_one, mul_neg, units.coe_neg, neg_smul, neg_neg, mul_one,
      int.units_coe_mul_self, one_smul, ← F.map_comp],
    erw ← nat_trans.naturality_assoc,
    rw [(shift_functor C (-1 : ℤ)).map_comp, assoc],
    dsimp only [functor.comp_map],
    congr' 2,
    apply shift_compatibility_add_comm, },
  { dsimp,
    simp only [id_comp, comp_id, F.map_zsmul, preadditive.comp_zsmul, smul_smul, id_comp,
      preadditive.zsmul_comp, h, zpow_add, zpow_one, mul_neg, mul_one, units.coe_neg, neg_neg], },
end

end is_homological

end functor

end category_theory


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import init.data.ordering.basic init.coe init.data.to_string

/-- Reflect a C++ name object. The VM replaces it with the C++ implementation. -/
inductive name
| anonymous  : name
| mk_string  : string → name → name
| mk_numeral : unsigned → name → name

/-- Gadget for automatic parameter support. This is similar to the opt_param gadget, but it uses
    the tactic declaration names tac_name to synthesize the argument.
    Like opt_param, this gadget only affects elaboration.
    For example, the tactic will *not* be invoked during type class resolution. -/
@[reducible] def {u} auto_param (α : Sort u) (tac_name : name) : Sort u :=
α

@[simp] lemma {u} auto_param_eq (α : Sort u) (n : name) : auto_param α n = α :=
rfl

instance : inhabited name :=
⟨name.anonymous⟩

def mk_str_name (n : name) (s : string) : name :=
name.mk_string s n

def mk_num_name (n : name) (v : nat) : name :=
name.mk_numeral (unsigned.of_nat' v) n

def mk_simple_name (s : string) : name :=
mk_str_name name.anonymous s

instance string_to_name : has_coe string name :=
⟨mk_simple_name⟩

infix ` <.> `:65 := mk_str_name

open name

def name.get_prefix : name → name
| anonymous        := anonymous
| (mk_string s p)  := p
| (mk_numeral s p) := p

def name.update_prefix : name → name → name
| anonymous        new_p := anonymous
| (mk_string s p)  new_p := mk_string s new_p
| (mk_numeral s p) new_p := mk_numeral s new_p

-- Without this option, we get errors when defining the following definitions.
set_option eqn_compiler.ite false

def name.to_string_with_sep (sep : string) : name → string
| anonymous                := "[anonymous]"
| (mk_string s anonymous)  := s
| (mk_numeral v anonymous) := repr v
| (mk_string s n)          := name.to_string_with_sep n ++ sep ++ s
| (mk_numeral v n)         := name.to_string_with_sep n ++ sep ++ repr v

private def name.components' : name -> list name
| anonymous                := []
| (mk_string s n)          := mk_string s anonymous :: name.components' n
| (mk_numeral v n)         := mk_numeral v anonymous :: name.components' n

def name.components (n : name) : list name :=
(name.components' n).reverse

protected def name.to_string : name → string :=
name.to_string_with_sep "."

protected def name.repr (n : name) : string :=
"`" ++ n.to_string

instance : has_to_string name :=
⟨name.to_string⟩

instance : has_repr name :=
⟨name.repr⟩

/- TODO(Leo): provide a definition in Lean. -/
meta constant name.has_decidable_eq : decidable_eq name
/- Both cmp and lex_cmp are total orders, but lex_cmp implements a lexicographical order. -/
meta constant name.cmp : name → name → ordering
meta constant name.lex_cmp : name → name → ordering
meta constant name.append : name → name → name
meta constant name.is_internal : name → bool

protected meta def name.lt (a b : name) : Prop :=
name.cmp a b = ordering.lt

meta instance : decidable_rel name.lt :=
λ a b, ordering.decidable_eq _ _

meta instance : has_lt name :=
⟨name.lt⟩

attribute [instance] name.has_decidable_eq

meta instance : has_append name :=
⟨name.append⟩

/-- `name.append_after n i` return a name of the form n_i -/
meta constant name.append_after : name → nat → name

meta def name.is_prefix_of : name → name → bool
| p name.anonymous := ff
| p n              :=
  if p = n then tt else name.is_prefix_of p n.get_prefix

meta def name.is_suffix_of : name → name → bool
| anonymous _ := tt
| (mk_string s n) (mk_string s' n') := (s = s') && name.is_suffix_of n n'
| (mk_numeral v n) (mk_numeral v' n') := (v = v') && name.is_suffix_of n n'
| _ _ := ff

meta def name.replace_prefix : name → name → name → name
| anonymous        p p' := anonymous
| (mk_string s c)  p p' := if c = p then mk_string s p' else mk_string s (name.replace_prefix c p p')
| (mk_numeral v c) p p' := if c = p then mk_numeral v p' else mk_numeral v (name.replace_prefix c p p')


import Machine.Parser
import Machine.Options
import Lean.Elab

open Lean Machine.Types

namespace List
  def forAll {α : Type u} (P : α → Prop) : List α → Prop
  | []      => True
  | x :: xs => P x ∧ forAll P xs

  def successively {α : Type u} (R : α → α → Prop) : List α → Prop
  | []           => True
  | [x]          => True
  | x :: y :: ys => R x y ∧ successively R (y :: ys)

  def forLast {α : Type u} (P : α → Prop) : List α → Prop
  | []      => True
  | [x]     => P x
  | x :: xs => forLast P xs

  def forFirst {α : Type u} (P : α → Prop) : List α → Prop
  | []      => True
  | x :: xs => P x

  def nonempty {α : Type u} : List α → Prop
  | []      => False
  | x :: xs => True
end List

namespace Machine.Types
  def machine.next : machine → machine
  | ⟨stack, regs, flag, progc⟩ => ⟨stack, regs, flag, progc + 1⟩

  def machine.get (m : machine) (r : reg) : Int :=
  (m.regs.find? r).get!
end Machine.Types

namespace Machine.Simulator
  def condjmp (M : machine) (cond : Ordering) (ptr : Nat) : machine :=
  ⟨M.stack, M.regs, M.flag, if M.flag == cond then ptr else M.progc + 1⟩

  def instr.eval (M : machine) : instr → machine
  | instr.push z => ⟨M.stack.push z, M.regs, M.flag, M.progc + 1⟩
  | instr.pushr r => ⟨M.stack.push (M.get r), M.regs, M.flag, M.progc + 1⟩
  | instr.popr r => ⟨M.stack.pop, M.regs.replace r M.stack.back, M.flag, M.progc + 1⟩
  | instr.dup => ⟨M.stack.push M.stack.back, M.regs, M.flag, M.progc + 1⟩
  | instr.add r₁ r₂ r₃ => ⟨M.stack, M.regs.replace r₃ (M.get r₁ + M.get r₂), M.flag, M.progc + 1⟩
  | instr.neg r₁ r₂ => ⟨M.stack, M.regs.replace r₂ (-M.get r₁), M.flag, M.progc + 1⟩
  | instr.mul r₁ r₂ r₃ => ⟨M.stack, M.regs.replace r₃ (M.get r₁ * M.get r₂), M.flag, M.progc + 1⟩
  | instr.cmp r₁ r₂ => ⟨M.stack, M.regs, compare (M.get r₁) (M.get r₂), M.progc + 1⟩
  | instr.jmp ptr => ⟨M.stack, M.regs, M.flag, ptr⟩
  | instr.je ptr => condjmp M Ordering.eq ptr
  | instr.jg ptr => condjmp M Ordering.gt ptr
  | instr.jl ptr => condjmp M Ordering.lt ptr
  | instr.dump => M.next

  def instr.effect (M : machine) : instr → IO Unit
  | instr.dump => do println! "r1 = {M.get reg.r1}, r2 = {M.get reg.r2}, r3 = {M.get reg.r3}, r4 = {M.get reg.r4}"
  | _          => return ()

  def tick (M : machine) (ρ : tape) : Option machine :=
  match ρ.get? M.progc with
  | none   => none
  | some ε => some (instr.eval M ε)

  def effect (M : machine) (ρ : tape) : IO Unit :=
  match ρ.get? M.progc with
  | none   => return ()
  | some ε => instr.effect M ε

  private def await (M₀ : machine) (ρ : tape) : Nat → IO Unit
  |   0   => throw (IO.userError "execution depth was reached")
  | n + 1 => do effect M₀ ρ; match tick M₀ ρ with
    | none   => return ()
    | some M => await M ρ n

  private partial def unsafeAwait (M₀ : machine) (ρ : tape) : IO Unit :=
  do effect M₀ ρ; match tick M₀ ρ with
  | none   => return ()
  | some M => unsafeAwait M ρ

  def simulate :=
  unsafeAwait machine.init

  elab "asm " label:ident xs:mnemonic* " end" : command => do
    let (ρ, M) ← Machine.Parser.expand xs
    let xs ← Array.mapM instr.restore ρ
    Elab.Command.elabDeclaration (← `(def $label : Array instr := #[$xs,*]))

    let opts ← getOptions

    if Machine.Options.debugAsm.get opts then
      do await M ρ (Machine.Options.executionDepth.get opts)
    else return ()

  def computes (ρ : tape) (M₁ M₂ : machine) :=
  tick M₁ ρ = some M₂

  def completed (ρ : tape) (M : machine) :=
  tick M ρ = none

  def clean (M : machine) :=
  M = machine.init

  def allowed (ρ : tape) (L : List machine) :=
  L.successively (computes ρ) ∧ L.forLast (completed ρ)

  def terminator (ρ : tape) (L : List machine) :=
  L.nonempty ∧ L.forFirst clean ∧ allowed ρ L

  def terminating (ρ : tape) :=
  ∃ L, terminator ρ L

  asm loop
    M: jmp M
  end

  theorem some_inj {α : Type u} {a b : α} (p : some a = some b) : a = b :=
  by { apply Option.noConfusion p; apply id }

  theorem loop.conservative : ∀ (M₁ M₂ : machine), tick M₁ loop = M₂ → M₁ = M₂ :=
  λ ⟨stack₁, regs₁, flags₁, progc₁⟩ ⟨stack₂, regs₂, flags₂, progc₂⟩ H => by {
    induction progc₁; apply some_inj H; cases H
  }

  theorem loopTerminator : ∀ (L : List machine), terminator loop L → False
  | [], ⟨p, _⟩ => p
  | [x], ⟨_, ⟨q, ⟨_, h⟩⟩⟩ => by { rw [q] at h; cases h }
  | x :: y :: ys, ⟨p, ⟨q, ⟨r, h⟩⟩⟩ => by {
    apply loopTerminator (y :: ys); apply And.intro;
    apply True.intro; apply And.intro; rw [←loop.conservative x y r.left];
    apply q; apply And.intro; apply r.right; apply h
  }

  theorem nonterminating : ¬terminating loop :=
  λ | Exists.intro L η => loopTerminator L η
end Machine.Simulator


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.simulation_semantics.simulate.support
import computational_monads.simulation_semantics.simulate.eval_dist
import computational_monads.simulation_semantics.simulate.subsingleton
import computational_monads.support.prod

/-!
# Tracking Simulation Oracle

This file defines a constructor for simulation oracles that use the internal state
for the purpose of tracking some value, in a way that doesn't affect the actual query result.
For example a logging oracle just tracks the queries, without actually affecting the return value.

The definition is in terms of a query function that responds to queries,
and an indepdent update_state function that controls the internal state.
For simplicity the update state function rather than having oracle access.

In many cases this definition will be composed with an oracle with result depending on the state,
but this construction allows seperation of the components that affect state independently.
-/

variables {α β γ : Type} {spec spec' spec'': oracle_spec}

structure tracking_sim_oracle (spec spec' : oracle_spec) (S : Type)
  extends sim_oracle spec spec' S :=
(default_state := default_state)
(answer_query : Π (i : spec.ι), spec.domain i → oracle_comp spec' (spec.range i))
(update_state : Π (s : S) (i : spec.ι), spec.domain i → spec.range i → S)
(o := λ i x, (λ u, (u, update_state x.2 i x.1 u)) <$> (answer_query i x.1))

structure stateless_sim_oracle (spec spec' : oracle_spec)
  extends tracking_sim_oracle spec spec' unit :=
(default_state := ())
(answer_query := answer_query)
(update_state := λ _ _ _ _, ())
(o := λ i x, (λ u, (u, ())) <$> (answer_query i x.1))

def identi_o (spec : oracle_spec) : stateless_sim_oracle spec spec :=
{ answer_query := λ i t, oracle_comp.query i t }

/-- Oracle where the query result is indepenent of the current oracle state,
although the new state may depend upon the previous state.
For example a logging oracle that just tracks the input and output of queries.
`o` is the way the oracle responds to queries, which doesn't have access to the state.
`update_state` takes a query and internal state and returns the new internal state.
Note that `update_state` is not a probabalistic function, and has no oracle access -/
def tracking_oracle {spec : oracle_spec} {S : Type}
  (o : Π (i : spec.ι), spec.domain i → oracle_comp spec' (spec.range i))
  (update_state : Π (s : S) (i : spec.ι), spec.domain i → spec.range i → S)
  (default_state : S) : sim_oracle spec spec' S :=
{ default_state := default_state,
  o := λ i ⟨t, s⟩, (λ u, (u, update_state s i t u)) <$> (o i t) }

notation `⟪` o `|` update_state `,` default_state `⟫` :=
  tracking_oracle o update_state default_state

namespace tracking_oracle

open_locale big_operators ennreal
open oracle_comp oracle_spec

variables {S S' : Type} (o : Π (i : spec.ι), spec.domain i → oracle_comp spec' (spec.range i))
  (o' : Π (i : spec.ι), spec.domain i → oracle_comp spec'' (spec.range i))
  (update_state : Π (s : S) (i : spec.ι), spec.domain i → spec.range i → S)
  (update_state' : Π (s : S') (i : spec.ι), spec.domain i → spec.range i → S')
  (default_state : S) (default_state' : S') (a : α) (i : spec.ι) (t : spec.domain i)
  (oa : oracle_comp spec α) (ob : α → oracle_comp spec β) (s : S) (s' : S')
  (x : spec.domain i × S) (y : spec.range i × S)

@[simp] lemma apply_eq : ⟪o | update_state, default_state⟫ i x =
  (λ u, (u, update_state x.2 i x.1 u)) <$> (o i x.1) := by {cases x, refl}

instance decidable [decidable_eq S] [∀ i x, (o i x).decidable] :
  (⟪o | update_state, default_state⟫ i x).decidable :=
by { rw [apply_eq], exact oracle_comp.decidable_map _ _ }

section support

@[simp] lemma support_apply : (⟪o | update_state, default_state⟫ i x).support =
  (λ u, (u, update_state x.2 i x.1 u)) '' (o i x.1).support :=
set.ext (λ y, by rw [apply_eq, support_map])

lemma fin_support_apply [∀ i t, (o i t).decidable] [decidable_eq S] :
  (⟪o | update_state, default_state⟫ i x).fin_support =
    (o i x.1).fin_support.image (λ u, (u, update_state x.2 i x.1 u)) :=
by simp only [fin_support_eq_iff_support_eq_coe, apply_eq, support_map,
  finset.coe_image, coe_fin_support_eq_support]

lemma mem_support_apply_iff {y : spec.range i × S} :
  y ∈ (⟪o | update_state, default_state⟫ i x).support ↔
    y.1 ∈ (o i x.1).support ∧ update_state x.2 i x.1 y.1 = y.2 :=
by simp only [support_apply, prod.eq_iff_fst_eq_snd_eq, set.mem_image,
  and_comm (_ = y.fst), exists_eq_right_right]

/-- If the oracle can take on any value then the first element of the support is unchanged -/
theorem support_simulate'_eq_support (h : ∀ i t, (o i t).support = ⊤) :
  (simulate' ⟪o | update_state, default_state⟫ oa s).support = oa.support :=
support_simulate'_eq_support _ oa s (λ i t s, set.ext (λ x, by simp only
  [h, set.top_eq_univ, set.mem_univ, true_and, apply_eq, support_map, set.mem_image,
    prod.exists, prod.mk.inj_iff, exists_eq_left, exists_eq_left', exists_apply_eq_apply]))

/-- Particular case of `support_simulate'_eq_support` for `query`.
In particular a tracking oracle that *only* does tracking doesn't affect the main output. -/
@[simp] lemma support_simulate'_query_eq_support :
  (simulate' ⟪query | update_state, default_state⟫ oa s).support = oa.support :=
support_simulate'_eq_support query update_state default_state oa s (λ _ _, rfl)

theorem support_simulate'_eq_support_simulate' (h : ∀ i t, (o i t).support = (o' i t).support) :
  (simulate' ⟪o | update_state, default_state⟫ oa s).support =
    (simulate' ⟪o' | update_state', default_state'⟫ oa s').support :=
support_simulate'_eq_support_simulate' (λ i t s s', set.ext $ λ x,
  by simp only [mem_support_apply_iff, h, simulate'_query, support_map, support_apply,
    set.mem_image, set.mem_set_of_eq, prod.exists, exists_and_distrib_right, exists_eq_right,
    exists_eq_right', exists_eq_right_right, prod.eq_iff_fst_eq_snd_eq, and_comm (_ = x)]) oa s s'

/-- The support of `simulate'` is independt of the tracking functions -/
theorem support_simulate'_eq_support_simulate'_of_oracle_eq :
  (simulate' ⟪o | update_state, default_state⟫ oa s).support =
    (simulate' ⟪o | update_state', default_state'⟫ oa s').support :=
support_simulate'_eq_support_simulate' o o _ _ _ _ oa s s' (λ _ _, rfl)

section subsingleton

variables [subsingleton S]

@[simp] lemma support_apply_of_subsingleton :
  (⟪o | update_state, default_state⟫ i x).support = prod.fst ⁻¹' (o i x.1).support :=
set.ext (λ y, by erw [apply_eq, map_eq_bind_return_comp,
  support_bind_prod_mk_of_snd_subsingleton, set.image_id])

lemma support_simulate_eq_preimage_support_of_subsingleton (h : ∀ i t, (o i t).support = ⊤) :
  (simulate ⟪o | update_state, default_state⟫ oa s).support = prod.fst ⁻¹' oa.support :=
by rw [set.preimage, support_simulate_eq_support_simulate'_of_subsingleton,
  support_simulate'_eq_support o _ _ oa s h]

@[simp] lemma support_simulate_query_eq_support_of_subsingleton :
  (simulate ⟪query | update_state, default_state⟫ oa s).support = prod.fst ⁻¹' oa.support :=
support_simulate_eq_preimage_support_of_subsingleton query _ _ oa s (λ _ _, rfl)

end subsingleton

end support

section eval_dist

@[simp] lemma eval_dist_apply :
  ⁅⟪o | update_state, default_state⟫ i (t, s)⁆ = ⁅o i t⁆.map (λ u, (u, update_state s i t u)) :=
by rw [apply_eq, eval_dist_map]

/-- If the oracle has uniform distribution, then the distribution under `simulate'` is unchanged -/
theorem eval_dist_simulate'_eq_eval_dist
  (h : ∀ i t, ⁅o i t⁆ = pmf.uniform_of_fintype (spec.range i)) :
  ⁅simulate' ⟪o | update_state, default_state⟫ oa s⁆ = ⁅oa⁆ :=
eval_dist_simulate'_eq_eval_dist _ oa s (λ i t s, trans
  (by simpa [eval_dist_apply, pmf.map_comp] using pmf.map_id ⁅o i t⁆) (h i t))

/-- Specific case of `eval_dist_simulate'_eq_eval_dist` for query.
In particular if a tracking oracle *only* does tracking gives the same main output distribution. -/
@[simp] lemma eval_dist_simulate'_query_eq_eval_dist :
  ⁅simulate' ⟪query | update_state, default_state⟫ oa s⁆ = ⁅oa⁆ :=
eval_dist_simulate'_eq_eval_dist query update_state default_state oa s (λ _ _, rfl)

lemma eval_dist_simulate'_eq_eval_dist_simulate'
  (h : ∀ i t, o i t ≃ₚ o' i t) : ⁅simulate' ⟪o | update_state, default_state⟫ oa s⁆ =
    ⁅simulate' ⟪o' | update_state', default_state'⟫ oa s'⁆ :=
eval_dist_simulate'_eq_eval_dist_simulate' (λ i t s s',
  sorry) _ _ _ --by simp [pmf.map_comp, tracking_oracle.apply_eq, eval_dist_map, h]) oa s s'

/-- The first output of simulation under different `tracking_oracle` with the same oracle
is the same regardless of if the tracking functions are different. -/
theorem eval_dist_simulate'_eq_eval_dist_simulate'_of_oracle_eq :
  ⁅simulate' ⟪o | update_state, default_state⟫ oa s⁆ =
    ⁅simulate' ⟪o | update_state', default_state'⟫ oa s'⁆ :=
eval_dist_simulate'_eq_eval_dist_simulate' o o _ _ _ _ oa s s' (λ _ _, rfl)

end eval_dist

section prob_event

variable (e : set α)

@[simp] lemma prob_event_apply (e : set (spec.range i × S)) :
  ⁅e | ⟪o | update_state, default_state⟫ i (t, s)⁆ =
    ⁅λ u, (u, update_state s i t u) ∈ e | o i t⁆ :=
by simpa only [apply_eq, prob_event_map]

lemma prob_event_simulate'_eq_prob_event
  (h : ∀ i t, ⁅o i t⁆ = pmf.uniform_of_fintype (spec.range i)) :
  ⁅e | simulate' ⟪o | update_state, default_state⟫ oa s⁆ = ⁅e | oa⁆ :=
prob_event_eq_of_eval_dist_eq (eval_dist_simulate'_eq_eval_dist _ _ _ _ _ h) e

/-- Specific case of `eval_dist_simulate'_eq_eval_dist` for query.
In particular if a tracking oracle *only* does tracking gives the same main output distribution. -/
lemma prob_event_simulate'_query_eq_prob_event :
  ⁅e | simulate' ⟪query | update_state, default_state⟫ oa s⁆ = ⁅e | oa⁆ :=
prob_event_simulate'_eq_prob_event _ _ _ oa s e (λ _ _, rfl)

lemma prob_event_simulate'_eq_prob_event_simulate'
  (h : ∀ i t, o i t ≃ₚ o' i t) : ⁅e | simulate' ⟪o | update_state, default_state⟫ oa s⁆ =
    ⁅e | simulate' ⟪o' | update_state', default_state'⟫ oa s'⁆ :=
prob_event_eq_of_eval_dist_eq (eval_dist_simulate'_eq_eval_dist_simulate' _ _ _ _ _ _ _ _ _ h) e

/-- The first output of simulation under different `tracking_oracle` with the same oracle
is the same regardless of if the tracking functions are different. -/
theorem prob_event_simulate'_eq_eval_dist_simulate'_of_oracle_eq :
  ⁅e | simulate' ⟪o | update_state, default_state⟫ oa s⁆ =
    ⁅e | simulate' ⟪o | update_state', default_state'⟫ oa s'⁆ :=
prob_event_simulate'_eq_prob_event_simulate' o o _ _ _ _ oa s s' e (λ _ _, rfl)

end prob_event

end tracking_oracle


import data.quot
import .homotopy_classes

universes v u

open category_theory
local notation f ` ∘ `:80 g:80 := g ≫ f

namespace homotopy_theory.cofibrations
-- Homotopy equivalences as the weak equivalences of an I-category.
open homotopy_theory.weak_equivalences

variables {C : Type u} [category.{v} C]
  [has_initial_object.{v} C] [has_coproducts.{v} C] [I_category.{v} C]

instance homotopy_category.category_with_weak_equivalences :
  category_with_weak_equivalences (category_mod_congruence C homotopy_congruence) :=
isomorphisms_as_weak_equivalences

instance I_category.category_with_weak_equivalences : category_with_weak_equivalences C :=
preimage_with_weak_equivalences (quotient_functor C homotopy_congruence)

def homotopy_equivalence {x y : C} (f : x ⟶ y) : Prop := is_weq f

lemma homotopic_iff_equal_in_ho {x y : C} {f g : x ⟶ y} : f ≃ g ↔ ⟦f⟧ = ⟦g⟧ :=
by symmetry; apply quotient.eq

lemma homotopy_equivalence_iff {x y : C} {f : x ⟶ y} :
  homotopy_equivalence f ↔ ∃ g, g ∘ f ≃ 𝟙 _ ∧ f ∘ g ≃ 𝟙 _ :=
begin
  split,
  { intro h, cases h with i hi,
    cases quotient.exists_rep i.inv with g hg,
    existsi g, split; rw homotopic_iff_equal_in_ho,
    { have := i.hom_inv_id',
      rw [hi, ←hg] at this, exact this },
    { have := i.inv_hom_id',
      rw [hi, ←hg] at this, exact this } },
  { intro h, rcases h with ⟨g, h₁, h₂⟩,
    refine ⟨iso.mk ⟦f⟧ ⟦g⟧ _ _, rfl⟩;
    { dsimp [auto_param], change ⟦_⟧ = ⟦_⟧, rw ←homotopic_iff_equal_in_ho,
      exact h₁ <|> exact h₂ } }
end

end homotopy_theory.cofibrations


import Lean
open Lean Elab Command Term Meta

/- ## Elaboration: Solutions -/

/- ### 1. -/

elab n:term "♥" a:"♥"? b:"♥"? : term => do
  let nExpr : Expr ← elabTermEnsuringType n (mkConst `Nat)
  if let some a := a then
    if let some b := b then
      return Expr.app (Expr.app (Expr.const `Nat.add []) nExpr) (mkNatLit 3)
    else
      return Expr.app (Expr.app (Expr.const `Nat.add []) nExpr) (mkNatLit 2)
  else
    return Expr.app (Expr.app (Expr.const `Nat.add []) nExpr) (mkNatLit 1)

#eval 7 ♥ -- 8
#eval 7 ♥♥ -- 9
#eval 7 ♥♥♥ -- 10

/- ### 2. -/

-- a) using `syntax` + `@[command_elab alias] def elabOurAlias : CommandElab`
syntax (name := aliasA) (docComment)? "aliasA " ident " ← " ident* : command

@[command_elab «aliasA»]
def elabOurAlias : CommandElab := λ stx =>
  match stx with
  | `(aliasA $x:ident ← $ys:ident*) =>
    for y in ys do
      Lean.logInfo y
  | _ =>
    throwUnsupportedSyntax

aliasA hi.hello ← d.d w.w nnn

-- b) using `syntax` + `elab_rules`.
syntax (name := aliasB) (docComment)? "aliasB " ident " ← " ident* : command

elab_rules : command
  | `(command | aliasB $m:ident ← $ys:ident*) =>
    for y in ys do
      Lean.logInfo y

aliasB hi.hello ← d.d w.w nnn

-- c) using `elab`
elab "aliasC " x:ident " ← " ys:ident* : command =>
  for y in ys do
    Lean.logInfo y

aliasC hi.hello ← d.d w.w nnn

/- ### 3. -/

open Parser.Tactic

-- a) using `syntax` + `@[tactic nthRewrite] def elabNthRewrite : Lean.Elab.Tactic.Tactic`.
syntax (name := nthRewriteA) "nth_rewriteA " (config)? num rwRuleSeq (ppSpace location)? : tactic

@[tactic nthRewriteA] def elabNthRewrite : Lean.Elab.Tactic.Tactic := fun stx => do
  match stx with
  | `(tactic| nth_rewriteA $[$cfg]? $n $rules $_loc) =>
    Lean.logInfo "rewrite location!"
  | `(tactic| nth_rewriteA $[$cfg]? $n $rules) =>
    Lean.logInfo "rewrite target!"
  | _ =>
    throwUnsupportedSyntax

-- b) using `syntax` + `elab_rules`.
syntax (name := nthRewriteB) "nth_rewriteB " (config)? num rwRuleSeq (ppSpace location)? : tactic

elab_rules (kind := nthRewriteB) : tactic
  | `(tactic| nth_rewriteB $[$cfg]? $n $rules $_loc) =>
    Lean.logInfo "rewrite location!"
  | `(tactic| nth_rewriteB $[$cfg]? $n $rules) =>
    Lean.logInfo "rewrite target!"

-- c) using `elab`.
elab "nth_rewriteC " (config)? num rwRuleSeq loc:(ppSpace location)? : tactic =>
  if let some loc := loc then
    Lean.logInfo "rewrite location!"
  else
    Lean.logInfo "rewrite target!"

example : 2 + 2 = 4 := by
  nth_rewriteC 2 [← add_zero] at h
  nth_rewriteC 2 [← add_zero]
  sorry