import for_mathlib.ab4
import algebra.category.Module.colimits
import for_mathlib.AddCommGroup.ab4

open category_theory
open category_theory.limits

local attribute [instance] category_theory.limits.has_zero_object.has_zero

universes v'' v' v u'' u' u

open_locale classical

instance Module.forget₂_AddCommGroup_preserves_zero_morphisms {R : Type*} [ring R]
  : (forget₂ (Module R) AddCommGroup).preserves_zero_morphisms := ⟨⟩

instance Module.forget₂_AddCommGroup_faithful {R : Type*} [ring R]
  : faithful (forget₂ (Module R) AddCommGroup) :=
begin
  refine ⟨_⟩,
  intros X Y f g H,
  ext x,
  rw [← linear_map.to_add_monoid_hom_coe, ← linear_map.to_add_monoid_hom_coe],
  exact congr_arg2 _ H (refl x)
end.

noncomputable
instance Module.forget₂_AddCommGroup_reflects_exact_sequences {R : Type*} [ring R]
  : functor.reflects_exact_sequences (forget₂ (Module R) AddCommGroup) :=
begin
  apply functor.reflects_exact_sequences_of_preserves_zero_morphisms_of_faithful
end

instance Module.forget₂_AddCommGroup_reflects_mono {R : Type*} [ring R]
  : functor.reflects_monomorphisms (forget₂ (Module R) AddCommGroup) := by apply_instance

instance Module.forget₂_AddCommGroup_preserves_mono {R : Type*} [ring R]
  : functor.preserves_monomorphisms (forget₂ (Module R) AddCommGroup) := by apply_instance

instance coextension.module_structure (R : Type*) [ring R] (G : Type*) [add_comm_group G]
  : module R (R →+ G) := {
    smul := λ r f, ⟨(λ x, f (x * r)), (by simp), (by { intros, simp [add_mul] })⟩,
    one_smul  := by { intros, simp },
    mul_smul  := by { intros, ext, simp [mul_assoc] },
    smul_add  := by { intros, ext, simp },
    smul_zero := by { intros, ext, simp },
    add_smul  := by { intros, ext, simp [mul_add] },
    zero_smul := by { intros, ext, simp }
  }.

def coextension.map' (R : Type*) [ring R] {G H : Type*} [add_comm_group G] [add_comm_group H]
  (ϕ : G →+ H) : (R →+ G) →ₗ[R] (R →+ H) := {
    to_fun := λ f, ⟨ϕ.comp f, by simp, by { intros, simp }⟩,
    map_add' := by { intros, ext, simp },
    map_smul' := by { intros, ext, simp, refl }
  }.

def Module.coextension (R : Type*) [ring R] : AddCommGroup ⥤ Module R := {
  obj := λ G, Module.of R (R →+ G),
  map := λ G H ϕ, Module.of_hom (coextension.map' R ϕ)
}.

def Module.restriction_coextension_adj_unit (R : Type*) [ring R]
  (M : Type*) [add_comm_group M] [module R M] : M →ₗ[R] (R →+ M) := {
    to_fun := λ x, ⟨(λ r, r • x), zero_smul R x, (λ r s, add_smul r s x)⟩,
    map_add' := by { intros, ext, simp },
    map_smul' := by { intros, ext, simp, symmetry, apply mul_smul }
  }.

def Module.restriction_coextension_adj_counit (R : Type*) [ring R]
  (G : Type*) [add_comm_group G] : (R →+ G) →+ G := {
    to_fun := λ f, f 1,
    map_zero' := rfl,
    map_add' := λ x y, rfl
  }.

def Module.restriction_coextension_adj (R : Type*) [ring R]
  : forget₂ (Module R) AddCommGroup ⊣ Module.coextension R :=
  adjunction.mk_of_unit_counit {
    unit := {
      app := λ M, Module.restriction_coextension_adj_unit R M,
      naturality' := by { intros, ext, symmetry, apply map_smul f }
    },
    counit := {
      app := λ G, Module.restriction_coextension_adj_counit R G,
      naturality' := by { intros, ext, refl }
    },
    left_triangle' := by { ext, exact one_smul _ _ },
    right_triangle' := by { ext M f r, exact congr_arg f.to_fun (one_mul r) }
  }.

instance Module.forget₂_AddCommGroup_preserves_coproduct {R : Type*} [ring R]
  {J : Type*} (f : J → Module R)
  : limits.preserves_colimit (discrete.functor f) (forget₂ (Module R) AddCommGroup) :=
  @preserves_colimits_of_shape.preserves_colimit _ _ _ _ _ _ _
    (@preserves_colimits_of_size.preserves_colimits_of_shape _ _ _ _ _
      (@preserves_colimits_of_size_shrink _ _ _ _ _
        (Module.restriction_coextension_adj R).left_adjoint_preserves_colimits) _ _) _

lemma sigma_comparison_naturality {β : Type*} {C : Type*} [category C] {D : Type*} [category D]
  (G : C ⥤ D) {f g : β → C} (η : Π (b : β), f b ⟶ g b) [has_coproduct f] [has_coproduct g]
  [has_coproduct (λ (b : β), G.obj (f b))]  [has_coproduct (λ (b : β), G.obj (g b))]
  : sigma_comparison G f
  ≫ G.map (colim_map (discrete.nat_trans (λ b', η b'.as) : discrete.functor f ⟶ discrete.functor g))
  = colim_map (discrete.nat_trans (λ b', G.map (η b'.as)) : discrete.functor (λ (b : β), G.obj (f b)) ⟶ discrete.functor (λ (b : β), G.obj (g b)))
  ≫ sigma_comparison G g :=
begin
  ext,
  simp [sigma_comparison],
  rw [← G.map_comp, ← G.map_comp],
  refine congr_arg _ _,
  delta sigma.ι,
  simp
end

-- not sure about the universes here
lemma AB4_of_preserves_coproduct_and_reflects_and_preserves_mono {V W : Type u}
  [category.{v} V] [category.{v} W] [abelian V] [abelian W]
  [i : has_coproducts V] [i' : has_coproducts W]
  (F : V ⥤ W) [F.reflects_monomorphisms] [F.preserves_monomorphisms]
  [∀ (J : Type v) (f : J → V), limits.preserves_colimit (discrete.functor f) F]
  [h : @AB4 W _ i'] : @AB4 V _ i :=
begin
  constructor,
  introsI,
  apply F.mono_of_mono_map,
  suffices : mono (F.map (colim_map (discrete.nat_trans (λ a', f a'.as) : discrete.functor X ⟶ discrete.functor Y))),
  { convert this,
    delta sigma.desc cofan.mk colim_map is_colimit.map cocones.precompose,
    congr,
    ext a, cases a, refl },
  have H := sigma_comparison_naturality F f,
  rw ← is_iso.eq_inv_comp at H,
  rw H,
  apply_with mono_comp {instances:=ff},
  { apply_instance },
  { apply_with mono_comp {instances:=ff},
    { convert AB4.cond (F.obj ∘ X) (F.obj ∘ Y) (λ a, F.map (f a)) (λ a, F.map_mono (f a)),
      delta sigma.desc cofan.mk colim_map is_colimit.map cocones.precompose, dsimp,
      congr,
      ext a, cases a, refl },
    { apply_instance } }
end

instance AB4 {R : Type u} [ring R] : AB4 (Module.{(max v u) u} R) :=
  @AB4_of_preserves_coproduct_and_reflects_and_preserves_mono _ _ _ _ _ _ _ _
    (forget₂ (Module.{(max v u) u} R) AddCommGroup.{max v u})
    _ _
    (λ J f, @preserves_colimits_of_shape.preserves_colimit _ _ _ _ _ _ _
              (@preserves_colimits_of_size.preserves_colimits_of_shape _ _ _ _ _
                (Module.restriction_coextension_adj.{u v} R).left_adjoint_preserves_colimits
                (discrete J) _) (discrete.functor f)) _.


import Lean.Elab
open Lean.Elab.Tactic
open Lean.Elab

syntax (name := poyo) "foo" : tactic
@[tactic poyo]
def evalpoyo : Tactic := fun stx => do
  logInfo m!"<h1>{1}</h1>"

def Set (α : Type u) := α → Prop
def Set.in (s : Set α) (a : α) := s a

notation:50 a " ∈ " s:50 => Set.in s a

def Set.pred (p : α → Prop) : Set α := p

notation "{" a "|" p "}" => Set.pred (fun a => p)

def Set.union (s₁ s₂ : Set α) : Set α :=
  { a | a ∈ s₁ ∨ a ∈ s₂ }

infix:65 " ∪ " => Set.union

def Set.inter (s₁ s₂ : Set α) : Set α :=
  { a | a ∈ s₁ ∧ a ∈ s₂ }

infix:70 " ∩ " => Set.inter

instance (s : Set α) [h : Decidable (s a)] : Decidable (a ∈ Set.pred s) := h

instance (s₁ s₂ : Set α) [Decidable (a ∈ s₁)] [Decidable (a ∈ s₂)] : Decidable (a ∈ s₁ ∩ s₂) :=
  inferInstanceAs (Decidable (_ ∧ _))

instance (s₁ s₂ : Set α) [Decidable (a ∈ s₁)] [Decidable (a ∈ s₂)] : Decidable (a ∈ s₁ ∪ s₂) :=
  inferInstanceAs (Decidable (_ ∨ _))

def main : IO Unit :=
  IO.println "Hello, world!"

abbrev ℕ := Nat

def a := 1

#check ℕ
#check evalpoyo
#check (1,2,3)
#check 3 * 3 = 9
#check (⟨9, ⟨3, rfl⟩⟩:{m: ℕ // ∃r, r * r = m})

theorem test1 {α} (a b : α) (as bs : List α) (h : a::as = b::bs) : a = b :=
by {
  foo;
  skip;
  trace_state;
  injection h;
  assumption;
}

def b:{ll: List (List ℕ) //∃m r, ll.length = m ∧ r * r = m ∧ m > 0} :=
  ⟨[[0,3,2,1], [2,1,0,3], [3,0,1,2], [1,2,3,0]],
  by {
    let m := 4; let r := 2;
    exists m;
    exists r;
    simp;
  }⟩

macro "inductionFinTerm " term:term " with " v:ident lt:ident t:tacticSeq : tactic => `(induction $term with | mk $v $lt => $t)
syntax "repeatWithNat " term " => " tacticSeq : tactic
macro_rules
  | `(tactic| repeatWithNat $num => $seq) => `(tactic| first | let trialNum := $num; ($seq); repeatWithNat (Nat.succ $num) => $seq | skip)

def h: ∃x, x = 0 := Subtype.existsOfSubtype ⟨0, by rfl⟩
noncomputable def aaaa: Nat := sorry
#check Classical.choice
noncomputable def indefiniteDescription {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : {x // p x} :=
  Classical.choice <| let ⟨x, px⟩ := h; ⟨⟨x, px⟩⟩
noncomputable def hoge {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : Nonempty {x // p x} :=
let ⟨w, prop⟩ := h; ⟨w, prop⟩
--てすと,カタカナ，漢字．１２３ｂｃｓ

constant magic (h : ∃ n : ℕ, n > 0) : ℕ
axiom magic_extract (n h) : magic ⟨n, h⟩ = n

example : false :=
have h1 : magic ⟨1, sorry⟩ = 1 := magic_extract _ _;
have h2 : magic ⟨2, sorry⟩ = 2 := magic_extract _ _;
have proof_irrel : magic ⟨1, sorry⟩ = magic ⟨2, sorry⟩ := rfl;
absurd (h1.symm.trans $ proof_irrel.trans h2) sorry


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 utils

/-!

Scripts to query
- The OpenAI Codex model for translations
- The `LeanAide` server to retrieve `mathlib` theorems similar to a given one.

-/

/-- Fetches the OpenAI key from the environment to query OpenAI Codex for translation. -/
meta def get_openai_key : io string := do
  some key ← io.env.get "OPENAI_API_KEY" | io.fail
      "`OPENAI_API_KEY` environment variable not found.
        This is required for the statement translation tool.
        Set it using the bash command `export OPENAI_API_KEY=<key>`,
        where `<key>` is your personal OpenAI key.",
  return key

/-- Fetch the IP address of the `LeanAide` server. -/
meta def lean_aide_ip : io string := do
  -- the permanent IP is `34.100.184.111:5000`
  -- this should be set as an environment variable
  some ip ← io.env.get "LEANAIDE_IP" | (do io.print_ln "Defaulting to local IP...", pure "localhost:5000"),
  return ip

section completion_request

/-! The code in this section is modified from `Lean Chat`. -/

/-- A structure for storing data for querying Codex. -/
structure completion_request : Type :=
  (prompt : string)
  (model : string := "code-davinci-002")
  (temperature : nat := 6) -- the actual temperature times `10`
  (n : nat := 7)
  (max_tokens : int := 150)
  (stop : list string := [":=", "/-", "-/", "\n\n"])

instance completion_request.from_str : has_coe string completion_request :=
  { coe := λ s, {prompt := s} }

-- An example completion request
def test_completion_request : completion_request :=
{ prompt := "For every epsilon greater than zero, ",  stop := ["."] }

/-- Export a `completion_request` to `json` format. -/
meta def completion_request.to_json : completion_request → json
 | ⟨prompt, model, temperature, n, max_tokens, stop⟩ :=
    json.object [
    ("prompt", json.of_string prompt),
    ("model", json.of_string model),
    ("temperature", json.of_float $ native.float.div temperature 10),
    ("n", json.of_int n),
    ("max_tokens", json.of_int max_tokens),
    ("stop", json.array $ json.of_string <$> stop)
    ]

/-- Query OpenAI Codex for completions. -/
meta def completion_request.query_codex (request : completion_request) : io json := do
    api_key ← get_openai_key,
    out ← io.cmd {cmd := "curl", args := [
      "--silent",
      "https://api.openai.com/v1/completions",
      "-X", "POST",
      "-H", "Content-Type: application/json",
      "-H", "Authorization: Bearer " ++ api_key,
      "--data", json.unparse request.to_json
    ]},
    some codex_completion ← pure (json.parse out) | io.fail "failed to parse json",
    return codex_completion

/-- Get the list of Codex completions as strings. -/
meta def completion_request.get_codex_completions (request : completion_request) : io (list string) := do
  codex_out ← completion_request.query_codex request,
  io.of_except $ do
    choices ← codex_out.lookup_as "choices" json.as_array,
    choices.mmap $ λ choice, choice.lookup_as "text" json.as_string

meta def test_completions : io unit := do
  s ← test_completion_request.get_codex_completions,
  io.print s

-- #eval test_completions

end completion_request

section similarity_prompts

/-- Query the `LeanAide` server to get `mathlib` theorems similar to a given statement. -/
meta def get_similarity_prompts (s : string) (n : nat := 15) : io (list json) := do
  let data := json.object [
    ("filename", "data/prompts.json"),
    ("field", "doc_string"),
    ("doc_string", s),
    ("n", n),
    ("model_name", "all-mpnet-base-v2")
    ],
  ip ← lean_aide_ip,
  out ← io.cmd {cmd := "curl", args := [
    "-X", "POST",
    "-H", "Content-Type: application/json",
    "--data", json.unparse data,
    sformat!"{ip}/nearest_prompts"
  ]},
  io.of_except $
    let sim_prompts := except.of_option (json.parse out) "failed to parse json" in
      sim_prompts >>= json.as_array

meta def test_similarity_prompts : io unit := do
  let stmt := "Every prime number is either `2` or odd.",
  prompts ← get_similarity_prompts stmt 5,
  io.print prompts

end similarity_prompts


variable (C : Type) [Inhabited C]

example : C := arbitrary

variable {C}

example : C := arbitrary


/-
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.meta.tactic init.meta.set_get_option_tactics

namespace tactic
meta constant back_lemmas : Type

/- Create a datastructure containing all lemmas tagged as [intro].
   Lemmas are indexed using their head-symbol.
   The head-symbol is computed with respect to the given transparency setting. -/
meta constant mk_back_lemmas_core     : transparency → tactic back_lemmas
/- (back_lemmas_insert_core m lemmas lemma) adds the given lemma to the set back_lemmas.
   It infers the type of the lemma, and uses its head-symbol as an index.
   The head-symbol is computed with respect to the given transparency setting. -/
meta constant back_lemmas_insert_core : transparency → back_lemmas → expr → tactic back_lemmas
/- Return the lemmas that have the same head symbol of the given expression -/
meta constant back_lemmas_find        : back_lemmas → expr → tactic (list expr)

meta def mk_back_lemmas : tactic back_lemmas :=
mk_back_lemmas_core reducible

meta def back_lemmas_insert : back_lemmas → expr → tactic back_lemmas :=
back_lemmas_insert_core reducible

/- (backward_chaining_core t insts max_depth pre_tactic leaf_tactic lemmas): perform backward chaining using
   the lemmas marked as [intro] and extra_lemmas.

   The search maximum depth is \c max_depth.

   Before processing each goal, the tactic pre_tactic is invoked. The possible outcomes are:
      1) it closes the goal
      2) it does nothing, and backward_chaining_core tries applicable lemmas.
      3) it fails, and backward_chaining_core backtracks.

   Whenever no lemma is applicable, the leaf_tactic is invoked, to try to close the goal.
   If insts is tt, then type class resolution is used to discharge goals.

   Remark pre_tactic may also be used to trace the execution of backward_chaining_core -/
meta constant backward_chaining_core : transparency → bool → nat → tactic unit → tactic unit → back_lemmas → tactic unit

meta def back_lemmas_add_extra : transparency → back_lemmas → list expr → tactic back_lemmas
| m bls []      := return bls
| m bls (l::ls) := do
  new_bls ← back_lemmas_insert_core m bls l,
  back_lemmas_add_extra m new_bls ls

meta def back_chaining_core (pre_tactic : tactic unit) (leaf_tactic : tactic unit) (extra_lemmas : list expr) : tactic unit :=
do intro_lemmas ← mk_back_lemmas_core reducible,
   new_lemmas   ← back_lemmas_add_extra reducible intro_lemmas extra_lemmas,
   max ← get_nat_option `back_chaining.max_depth 8,
   backward_chaining_core reducible tt max pre_tactic leaf_tactic new_lemmas

meta def back_chaining : tactic unit :=
back_chaining_core skip assumption []

meta def back_chaining_using : list expr → tactic unit :=
back_chaining_core skip assumption

meta def back_chaining_using_hs : tactic unit :=
local_context >>= back_chaining_core skip failed

end tactic


import lib.tactic

import tactic.rewrite_search.core.common

open tactic tactic.interactive

namespace tactic.rewrite_search.discovery

meta def assert_acceptable_lemma (r : expr) : tactic unit := do
  -- FIXME: unfold definitions to see if there is an eq or iff
  ret ← pure tt, -- is_acceptable_lemma r,
  if ret then return ()
  else do
    pp ← pp r,
    fail format!"\"{pp}\" is not a valid rewrite lemma!"

meta def load_attr_list : list name → tactic (list name)
| [] := return []
| (a :: rest) := do
  names ← attribute.get_instances a,
  l ← load_attr_list rest,
  return $ names ++ l

meta def load_names (l : list name) : tactic (list expr) :=
  l.mmap mk_const

meta def rewrite_list_from_rw_rules (rws : list rw_rule) : tactic (list (expr × bool)) :=
  rws.mmap (λ r, do e ← to_expr' r.rule, pure (e, r.symm))

meta def rewrite_list_from_lemmas (l : list expr) : list (expr × bool) :=
  l.map (λ e, (e, ff)) ++ l.map (λ e, (e, tt))

meta def rewrite_list_from_lemma (e : expr) : list (expr × bool) :=
  rewrite_list_from_lemmas [e]

meta def rewrite_list_from_hyps : tactic (list (expr × bool)) := do
  hyps ← local_context,
  rewrite_list_from_lemmas <$> hyps.mfilter is_acceptable_hyp

-- TODO mk_apps recursively
meta def inflate_under_apps (locals : list expr) : expr → tactic (list expr)
| e := do
  rws ← list.map prod.fst <$> mk_apps e locals,
  rws_extras ← list.join <$> rws.mmap inflate_under_apps,
  return $ e :: (rws ++ rws_extras)

meta def inflate_rw (locals : list expr) : expr × bool → tactic (list (expr × bool))
| (e, sy) := do
  as ← inflate_under_apps locals e,
  return $ as.map $ λ a, (a, sy)

meta def is_rewrite_lemma (d : declaration) : option (name × expr) :=
  let t := d.type in if is_acceptable_rewrite t then some (d.to_name, t) else none

meta def find_all_rewrites : tactic (list (name × expr)) := do
  e ← get_env,
  return $ e.decl_filter_map is_rewrite_lemma

end tactic.rewrite_search.discovery


import tactic.iconfig

section

iconfig_mk my_tac

set_option formatter.hide_full_terms false

iconfig_add my_tac [
  abool  : bool, -- (TODO:) := tt ! iconfig.overload_policy.ignore⟩,
  anum   : nat,
  aenum  : enat,
  astr   : string,
  aident : name,
]

end

namespace tactic
namespace interactive

meta def cfgdump (c : iconfig my_tac) : tactic unit := do
  l ← iconfig.read c,
  l.bool "abool" >>= tactic.trace,
  return ()

end interactive
end tactic

example : tt := begin
  cfgdump {
    abool := ff,
    anum := 113,
    aenum := inf,
    astr := "ello",
    aident s.sss4,
  },

  simp
end


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.meta.tactic
import Mathlib.Lean3Lib.init.meta.attribute
import Mathlib.Lean3Lib.init.meta.constructor_tactic
import Mathlib.Lean3Lib.init.meta.relation_tactics
import Mathlib.Lean3Lib.init.meta.occurrences
import Mathlib.Lean3Lib.init.data.option.basic

universes l

namespace Mathlib

def simp.default_max_steps : ℕ :=
  bit0
    (bit0
      (bit0
        (bit0
          (bit0
            (bit0
              (bit0
                (bit1
                  (bit0
                    (bit1
                      (bit1
                        (bit0
                          (bit1
                            (bit0
                              (bit0
                                (bit1
                                  (bit0 (bit0 (bit0 (bit1 (bit1 (bit0 (bit0 1))))))))))))))))))))))

/-- Prefix the given `attr_name` with `"simp_attr"`. -/
/-- Simp lemmas are used by the "simplifier" family of tactics.
`simp_lemmas` is essentially a pair of tables `rb_map (expr_type × name) (priority_list simp_lemma)`.
One of the tables is for congruences and one is for everything else.
An individual simp lemma is:
- A kind which can be `Refl`, `Simp` or `Congr`.
- A pair of `expr`s `l ~> r`. The rb map is indexed by the name of `get_app_fn(l)`.
- A proof that `l = r` or `l ↔ r`.
- A list of the metavariables that must be filled before the proof can be applied.
- A priority number
-/
/-- Make a new table of simp lemmas -/
/-- Merge the simp_lemma tables. -/
/-- Remove the given lemmas from the table. Use the names of the lemmas. -/
/-- Makes the default simp_lemmas table which is composed of all lemmas tagged with `simp`. -/
/-- Add a simplification lemma by an expression `p`. Some conditions on `p` must hold for it to be added, see list below.
If your lemma is not being added, you can see the reasons by setting `set_option trace.simp_lemmas true`.

- `p` must have the type `Π (h₁ : _) ... (hₙ : _), LHS ~ RHS` for some reflexive, transitive relation (usually `=`).
- Any of the hypotheses `hᵢ` should either be present in `LHS` or otherwise a `Prop` or a typeclass instance.
- `LHS` should not occur within `RHS`.
- `LHS` should not occur within a hypothesis `hᵢ`.

 -/
/-- Add a simplification lemma by it's declaration name. See `simp_lemmas.add` for more information.-/
/-- Adds a congruence simp lemma to simp_lemmas.
A congruence simp lemma is a lemma that breaks the simplification down into separate problems.
For example, to simplify `a ∧ b` to `c ∧ d`, we should try to simp `a` to `c` and `b` to `d`.
For examples of congruence simp lemmas look for lemmas with the `@[congr]` attribute.
```lean
lemma if_simp_congr ... (h_c : b ↔ c) (h_t : x = u) (h_e : y = v) : ite b x y = ite c u v := ...
lemma imp_congr_right (h : a → (b ↔ c)) : (a → b) ↔ (a → c) := ...
lemma and_congr (h₁ : a ↔ c) (h₂ : b ↔ d) : (a ∧ b) ↔ (c ∧ d) := ...
```
-/
/-- Add expressions to a set of simp lemmas using `simp_lemmas.add`.

  This is the new version of `simp_lemmas.append`,
  which also allows you to set the `symm` flag.
-/
/-- Add expressions to a set of simp lemmas using `simp_lemmas.add`.

  This is the backwards-compatibility version of `simp_lemmas.append_with_symm`,
  and sets all `symm` flags to `ff`.
-/
/-- `simp_lemmas.rewrite s e prove R` apply a simplification lemma from 's'

   - 'e'     is the expression to be "simplified"
   - 'prove' is used to discharge proof obligations.
   - 'r'     is the equivalence relation being used (e.g., 'eq', 'iff')
   - 'md'    is the transparency; how aggresively should the simplifier perform reductions.

   Result (new_e, pr) is the new expression 'new_e' and a proof (pr : e R new_e) -/
/-- `simp_lemmas.drewrite s e` tries to rewrite 'e' using only refl lemmas in 's' -/
namespace tactic

/- Remark: `transform` should not change the target. -/

/-- Revert a local constant, change its type using `transform`.  -/
/-- `get_eqn_lemmas_for deps d` returns the automatically generated equational lemmas for definition d.
   If deps is tt, then lemmas for automatically generated auxiliary declarations used to define d are also included. -/
structure dsimp_config where
  md : transparency
  max_steps : ℕ
  canonize_instances : Bool
  single_pass : Bool
  fail_if_unchanged : Bool
  eta : Bool
  zeta : Bool
  beta : Bool
  proj : Bool
  iota : Bool
  unfold_reducible : Bool
  memoize : Bool

end tactic

/-- (Definitional) Simplify the given expression using *only* reflexivity equality lemmas from the given set of lemmas.
   The resulting expression is definitionally equal to the input.

   The list `u` contains defintions to be delta-reduced, and projections to be reduced.-/
namespace tactic

/- Remark: the configuration parameters `cfg.md` and `cfg.eta` are ignored by this tactic. -/

/- Remark: we use transparency.instances by default to make sure that we
   can unfold projections of type classes. Example:

          (@has_add.add nat nat.has_add a b)
-/

/-- Tries to unfold `e` if it is a constant or a constant application.
    Remark: this is not a recursive procedure. -/
structure dunfold_config extends dsimp_config where

/- Remark: in principle, dunfold can be implemented on top of dsimp. We don't do it for
   performance reasons. -/

structure delta_config where
  max_steps : ℕ
  visit_instances : Bool

/-- Delta reduce the given constant names -/
structure unfold_proj_config extends dsimp_config where

/-- If `e` is a projection application, try to unfold it, otherwise fail. -/
structure simp_config where
  max_steps : ℕ
  contextual : Bool
  lift_eq : Bool
  canonize_instances : Bool
  canonize_proofs : Bool
  use_axioms : Bool
  zeta : Bool
  beta : Bool
  eta : Bool
  proj : Bool
  iota : Bool
  iota_eqn : Bool
  constructor_eq : Bool
  single_pass : Bool
  fail_if_unchanged : Bool
  memoize : Bool
  trace_lemmas : Bool

/--
  `simplify s e cfg r prove` simplify `e` using `s` using bottom-up traversal.
  `discharger` is a tactic for dischaging new subgoals created by the simplifier.
   If it fails, the simplifier tries to discharge the subgoal by simplifying it to `true`.

   The parameter `to_unfold` specifies definitions that should be delta-reduced,
   and projection applications that should be unfolded.
-/
/--
`ext_simplify_core a c s discharger pre post r e`:

- `a : α` - initial user data
- `c : simp_config` - simp configuration options
- `s : simp_lemmas` - the set of simp_lemmas to use. Remark: the simplification lemmas are not applied automatically like in the simplify tactic. The caller must use them at pre/post.
- `discharger : α → tactic α` - tactic for dischaging hypothesis in conditional rewriting rules. The argument 'α' is the current user data.
- `pre a s r p e` is invoked before visiting the children of subterm 'e'.
  + arguments:
    - `a` is the current user data
    - `s` is the updated set of lemmas if 'contextual' is `tt`,
    - `r` is the simplification relation being used,
    - `p` is the "parent" expression (if there is one).
    - `e` is the current subexpression in question.
  + if it succeeds the result is `(new_a, new_e, new_pr, flag)` where
    - `new_a` is the new value for the user data
    - `new_e` is a new expression s.t. `r e new_e`
    - `new_pr` is a proof for `r e new_e`, If it is none, the proof is assumed to be by reflexivity
    - `flag`  if tt `new_e` children should be visited, and `post` invoked.
- `(post a s r p e)` is invoked after visiting the children of subterm `e`,
  The output is similar to `(pre a r s p e)`, but the 'flag' indicates whether the new expression should be revisited or not.
- `r` is the simplification relation. Usually `=` or `↔`.
- `e` is the input expression to be simplified.

The method returns `(a,e,pr)` where

 - `a` is the final user data
 - `e` is the new expression
 - `pr` is the proof that the given expression equals the input expression.

Note that `ext_simplify_core` will succeed even if `pre` and `post` fail, as failures are used to indicate that the method should move on to the next subterm.
If it is desirable to propagate errors from `pre`, they can be propagated through the "user data".
An easy way to do this is to call `tactic.capture (do ...)` in the parts of `pre`/`post` where errors matter, and then use `tactic.unwrap a` on the result.

Additionally, `ext_simplify_core` does not propagate changes made to the tactic state by `pre` and `post.
If it is desirable to propagate changes to the tactic state in addition to errors, use `tactic.resume` instead of `tactic.unwrap`.
-/
structure simp_intros_config extends simp_config where
  use_hyps : Bool

end Mathlib


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 tactic.monotonicity.basic
import category.basic
import category.traversable
import category.traversable.derive

import data.dlist
import logic.basic
import tactic.basic

variables {a b c p : Prop}

namespace tactic.interactive

open lean lean.parser  interactive
open interactive.types
open tactic

local postfix `?`:9001 := optional
local postfix *:9001 := many

meta inductive mono_function (elab : bool := tt)
 | non_assoc : expr elab → list (expr elab) → list (expr elab) → mono_function
 | assoc : expr elab → option (expr elab) → option (expr elab) → mono_function
 | assoc_comm : expr elab → expr elab → mono_function

meta instance : decidable_eq mono_function :=
by mk_dec_eq_instance

meta def mono_function.to_tactic_format : mono_function → tactic format
 | (mono_function.non_assoc fn xs ys) := do
  fn' ← pp fn,
  xs' ← mmap pp xs,
  ys' ← mmap pp ys,
  return format!"{fn'} {xs'} _ {ys'}"
 | (mono_function.assoc fn xs ys) := do
  fn' ← pp fn,
  xs' ← pp xs,
  ys' ← pp ys,
  return format!"{fn'} {xs'} _ {ys'}"
 | (mono_function.assoc_comm fn xs) := do
  fn' ← pp fn,
  xs' ← pp xs,
  return format!"{fn'} _ {xs'}"

meta instance has_to_tactic_format_mono_function : has_to_tactic_format mono_function :=
{ to_tactic_format := mono_function.to_tactic_format }

@[derive traversable]
meta structure ac_mono_ctx' (rel : Type) :=
  (to_rel : rel)
  (function : mono_function)
  (left right rel_def : expr)

@[reducible]
meta def ac_mono_ctx := ac_mono_ctx' (option (expr → expr → expr))
@[reducible]
meta def ac_mono_ctx_ne := ac_mono_ctx' (expr → expr → expr)

meta def ac_mono_ctx.to_tactic_format (ctx : ac_mono_ctx) : tactic format :=
do fn  ← pp ctx.function,
   l   ← pp ctx.left,
   r   ← pp ctx.right,
   rel ← pp ctx.rel_def,
   return format!"{{ function := {fn}\n, left  := {l}\n, right := {r}\n, rel_def := {rel} }"

meta instance has_to_tactic_format_mono_ctx : has_to_tactic_format ac_mono_ctx :=
{ to_tactic_format := ac_mono_ctx.to_tactic_format }

meta def as_goal (e : expr) (tac : tactic unit) : tactic unit :=
do gs ← get_goals,
   set_goals [e],
   tac,
   set_goals gs

open list (hiding map) functor dlist

section config

parameter opt : mono_cfg
parameter asms : list expr

meta def unify_with_instance (e : expr) : tactic unit :=
as_goal e $
apply_instance
<|>
apply_opt_param
<|>
apply_auto_param
<|>
tactic.solve_by_elim { assumptions := pure asms }
<|>
reflexivity
<|>
applyc ``id
<|>
return ()

private meta def match_rule_head  (p : expr)
: list expr → expr → expr → tactic expr
 | vs e t :=
(unify t p >> mmap' unify_with_instance vs >> instantiate_mvars e)
<|>
do (expr.pi _ _ d b) ← return t | failed,
   v ← mk_meta_var d,
   match_rule_head (v::vs) (expr.app e v) (b.instantiate_var v)

meta def pi_head : expr → tactic expr
| (expr.pi n _ t b) :=
do v ← mk_meta_var t,
   pi_head (b.instantiate_var v)
| e := return e

meta def delete_expr (e : expr)
: list expr → tactic (option (list expr))
 | [] := return none
 | (x :: xs) :=
(compare opt e x >> return (some xs))
<|>
(map (cons x) <$> delete_expr xs)

meta def match_ac'
: list expr → list expr → tactic (list expr × list expr × list expr)
 | es (x :: xs) := do
    es' ← delete_expr x es,
    match es' with
     | (some es') := do
       (c,l,r) ← match_ac' es' xs, return (x::c,l,r)
     | none := do
       (c,l,r) ← match_ac' es xs, return (c,l,x::r)
    end
 | es [] := do
return ([],es,[])

meta def match_ac (unif : bool) (l : list expr) (r : list expr)
: tactic (list expr × list expr × list expr) :=
do (s',l',r') ← match_ac' l r,
   s' ← mmap instantiate_mvars s',
   l' ← mmap instantiate_mvars l',
   r' ← mmap instantiate_mvars r',
   return (s',l',r')

meta def match_prefix
: list expr → list expr → tactic (list expr × list expr × list expr)
| (x :: xs) (y :: ys) :=
  (do compare opt x y,
      prod.map ((::) x) id <$> match_prefix xs ys)
<|> return ([],x :: xs,y :: ys)
| xs ys := return ([],xs,ys)

/--
`(prefix,left,right,suffix) ← match_assoc unif l r` finds the
longest prefix and suffix common to `l` and `r` and
returns them along with the differences  -/
meta def match_assoc (l : list expr) (r : list expr)
: tactic (list expr × list expr × list expr × list expr) :=
do (pre,l₁,r₁) ← match_prefix l r,
   (suf,l₂,r₂) ← match_prefix (reverse l₁) (reverse r₁),
   return (pre,reverse l₂,reverse r₂,reverse suf)

meta def check_ac : expr → tactic (bool × bool × option (expr × expr × expr) × expr)
 | (expr.app (expr.app f x) y) :=
   do t ← infer_type x,
      a ← try_core $ to_expr ``(is_associative %%t %%f) >>= mk_instance,
      c ← try_core $ to_expr ``(is_commutative %%t %%f) >>= mk_instance,
      i ← try_core (do
          v ← mk_meta_var t,
          l_inst_p ← to_expr ``(is_left_id %%t %%f %%v),
          r_inst_p ← to_expr ``(is_right_id %%t %%f %%v),
          l_v ← mk_meta_var l_inst_p,
          r_v ← mk_meta_var r_inst_p ,
          l_id ← mk_mapp `is_left_id.left_id [some t,f,v,some l_v],
          mk_instance l_inst_p >>= unify l_v,
          r_id ← mk_mapp `is_right_id.right_id [none,f,v,some r_v],
          mk_instance r_inst_p >>= unify r_v,
          v' ← instantiate_mvars v,
          return (l_id,r_id,v')),
      return (a.is_some,c.is_some,i,f)
 | _ := return (ff,ff,none,expr.var 1)

meta def parse_assoc_chain' (f : expr) : expr → tactic (dlist expr)
 | e :=
 (do (expr.app (expr.app f' x) y) ← return e,
     is_def_eq f f',
     (++) <$> parse_assoc_chain' x <*> parse_assoc_chain' y)
<|> return (singleton e)

meta def parse_assoc_chain (f : expr) : expr → tactic (list expr) :=
map dlist.to_list ∘ parse_assoc_chain' f

meta def fold_assoc (op : expr) : option (expr × expr × expr) → list expr → option (expr × list expr)
| _ (x::xs) := some (foldl (expr.app ∘ expr.app op) x xs, [])
| none []   := none
| (some (l_id,r_id,x₀)) [] := some (x₀,[l_id,r_id])

meta def fold_assoc1 (op : expr) : list expr → option expr
| (x::xs) := some $ foldl (expr.app ∘ expr.app op) x xs
| []   := none

meta def same_function_aux
: list expr → list expr → expr → expr → tactic (expr × list expr × list expr)
 | xs₀ xs₁ (expr.app f₀ a₀) (expr.app f₁ a₁) :=
   same_function_aux (a₀ :: xs₀) (a₁ :: xs₁) f₀ f₁
 | xs₀ xs₁ e₀ e₁ := is_def_eq e₀ e₁ >> return (e₀,xs₀,xs₁)

meta def same_function : expr → expr → tactic (expr × list expr × list expr) :=
same_function_aux [] []

meta def parse_ac_mono_function (l r : expr)
: tactic (expr × expr × list expr × mono_function) :=
do (full_f,ls,rs) ← same_function l r,
   (a,c,i,f) ← check_ac l,
   if a
   then if c
   then do
     (s,ls,rs) ← monad.join (match_ac tt
                   <$> parse_assoc_chain f l
                   <*> parse_assoc_chain f r),
     (l',l_id) ← fold_assoc f i ls,
     (r',r_id) ← fold_assoc f i rs,
     s' ← fold_assoc1 f s,
     return (l',r',l_id ++ r_id,mono_function.assoc_comm f s')
   else do -- a ∧ ¬ c
     (pre,ls,rs,suff) ← monad.join (match_assoc
                   <$> parse_assoc_chain f l
                   <*> parse_assoc_chain f r),
     (l',l_id) ← fold_assoc f i ls,
     (r',r_id) ← fold_assoc f i rs,
     let pre'  := fold_assoc1 f pre,
     let suff' := fold_assoc1 f suff,
     return (l',r',l_id ++ r_id,mono_function.assoc f pre' suff')
   else do -- ¬ a
     (xs₀,x₀,x₁,xs₁) ← find_one_difference opt ls rs,
     return (x₀,x₁,[],mono_function.non_assoc full_f xs₀ xs₁)

meta def parse_ac_mono_function' (l r : pexpr) :=
do l' ← to_expr l,
   r' ← to_expr r,
   parse_ac_mono_function l' r'

meta def ac_monotonicity_goal : expr → tactic (expr × expr × list expr × ac_mono_ctx)
 | `(%%e₀ → %%e₁) :=
  do (l,r,id_rs,f) ← parse_ac_mono_function e₀ e₁,
     t₀ ← infer_type e₀,
     t₁ ← infer_type e₁,
     rel_def ← to_expr ``(λ x₀ x₁, (x₀ : %%t₀) → (x₁ : %%t₁)),
     return (e₀, e₁, id_rs,
            { function := f
            , left := l, right := r
            , to_rel := some $ expr.pi `x binder_info.default
            , rel_def := rel_def })
 | `(%%e₀ = %%e₁) :=
  do (l,r,id_rs,f) ← parse_ac_mono_function e₀ e₁,
     t₀ ← infer_type e₀,
     t₁ ← infer_type e₁,
     rel_def ← to_expr ``(λ x₀ x₁, (x₀ : %%t₀) = (x₁ : %%t₁)),
     return (e₀, e₁, id_rs,
            { function := f
            , left := l, right := r
            , to_rel := none
            , rel_def := rel_def })
 | (expr.app (expr.app rel e₀) e₁) :=
  do (l,r,id_rs,f) ← parse_ac_mono_function e₀ e₁,
     return (e₀, e₁, id_rs,
            { function := f
            , left := l, right := r
            , to_rel := expr.app ∘ expr.app rel
            , rel_def := rel })
 | _ := fail "invalid monotonicity goal"

meta def bin_op_left (f : expr)  : option expr → expr → expr
| none e := e
| (some e₀) e₁ := f.mk_app [e₀,e₁]

meta def bin_op (f a b : expr) : expr :=
f.mk_app [a,b]

meta def bin_op_right (f : expr) : expr → option expr → expr
| e none := e
| e₀ (some e₁) := f.mk_app [e₀,e₁]

meta def mk_fun_app : mono_function → expr → expr
 | (mono_function.non_assoc f x y) z := f.mk_app (x ++ z :: y)
 | (mono_function.assoc f x y) z := bin_op_left f x (bin_op_right f z y)
 | (mono_function.assoc_comm f x) z := f.mk_app [z,x]

meta inductive mono_law
   /- `assoc (l₀,r₀) (r₁,l₁)` gives first how to find rules to prove
      x+(y₀+z) R x+(y₁+z);
      if that fails, helps prove (x+y₀)+z R (x+y₁)+z -/
 | assoc : expr × expr → expr × expr → mono_law
   /- `congr r` gives the rule to prove `x = y → f x = f y` -/
 | congr : expr → mono_law
 | other : expr → mono_law

meta def mono_law.to_tactic_format : mono_law → tactic format
 | (mono_law.other e) := do e ← pp e, return format!"other {e}"
 | (mono_law.congr r) := do e ← pp r, return format!"congr {e}"
 | (mono_law.assoc (x₀,x₁) (y₀,y₁)) :=
do x₀ ← pp x₀,
   x₁ ← pp x₁,
   y₀ ← pp y₀,
   y₁ ← pp y₁,
   return format!"assoc {x₀}; {x₁} | {y₀}; {y₁}"

meta instance has_to_tactic_format_mono_law : has_to_tactic_format mono_law :=
{ to_tactic_format := mono_law.to_tactic_format }

meta def mk_rel (ctx : ac_mono_ctx_ne) (f : expr → expr) : expr :=
ctx.to_rel (f ctx.left) (f ctx.right)

meta def mk_congr_args (fn : expr) (xs₀ xs₁ : list expr) (l r : expr) : tactic expr :=
do p ← mk_app `eq [fn.mk_app $ xs₀ ++ l :: xs₁,fn.mk_app $ xs₀ ++ r :: xs₁],
   prod.snd <$> solve_aux p
     (do iterate_exactly (xs₁.length) (applyc `congr_fun),
         applyc `congr_arg)

meta def mk_congr_law (ctx : ac_mono_ctx) : tactic expr :=
match ctx.function with
 | (mono_function.assoc f x₀ x₁) :=
    if (x₀ <|> x₁).is_some
       then mk_congr_args f x₀.to_monad x₁.to_monad ctx.left ctx.right
       else failed
 | (mono_function.assoc_comm f x₀) := mk_congr_args f [x₀] [] ctx.left ctx.right
 | (mono_function.non_assoc f x₀ x₁) := mk_congr_args f x₀ x₁ ctx.left ctx.right
end

meta def mk_pattern (ctx : ac_mono_ctx) : tactic mono_law :=
match (sequence ctx : option (ac_mono_ctx' _)) with
 | (some ctx) :=
   match ctx.function with
    | (mono_function.assoc f (some x) (some y)) :=
      return $ mono_law.assoc
       ( mk_rel ctx (λ i, bin_op f x (bin_op f i y))
       , mk_rel ctx (λ i, bin_op f i y))
       ( mk_rel ctx (λ i, bin_op f (bin_op f x i) y)
       , mk_rel ctx (λ i, bin_op f x i))
    | (mono_function.assoc f (some x) none) :=
      return $ mono_law.other $
        mk_rel ctx (λ e, mk_fun_app ctx.function e)
    | (mono_function.assoc f none (some y)) :=
      return $ mono_law.other $
        mk_rel ctx (λ e, mk_fun_app ctx.function e)
    | (mono_function.assoc f none none) :=
      none
    | _ :=
      return $ mono_law.other $
         mk_rel ctx (λ e, mk_fun_app ctx.function e)
   end
 | none := mono_law.congr <$> mk_congr_law ctx
end

meta def match_rule (pat : expr) (r : name) : tactic expr :=
do  r' ← mk_const r,
    t  ← infer_type r',
    match_rule_head pat [] r' t

meta def find_lemma (pat : expr) : list name → tactic (list expr)
 | [] := return []
 | (r :: rs) :=
 do (cons <$> match_rule pat r <|> pure id) <*> find_lemma rs

meta def match_chaining_rules (ls : list name) (x₀ x₁ : expr) : tactic (list expr) :=
do x' ← to_expr ``(%%x₁ → %%x₀),
   r₀ ← find_lemma x' ls,
   r₁ ← find_lemma x₁ ls,
   return (expr.app <$> r₀ <*> r₁)

meta def find_rule (ls : list name) : mono_law → tactic (list expr)
 | (mono_law.assoc (x₀,x₁) (y₀,y₁)) :=
(match_chaining_rules ls x₀ x₁)
<|> (match_chaining_rules ls y₀ y₁)
 | (mono_law.congr r) := return [r]
 | (mono_law.other p) := find_lemma p ls

universes u v

lemma apply_rel {α : Sort u} (R : α → α → Sort v) {x y : α}
  (x' y' : α)
  (h : R x y)
  (hx : x = x')
  (hy : y = y')
: R x' y' :=
by { rw [← hx,← hy], apply h }

meta def ac_refine (e : expr) : tactic unit :=
refine ``(eq.mp _ %%e) ; ac_refl

meta def one_line (e : expr) : tactic format :=
do lbl ← pp e,
   asm ← infer_type e >>= pp,
   return format!"\t{asm}\n"

meta def side_conditions (e : expr) : tactic format :=
do let vs := e.list_meta_vars,
   ts ← mmap one_line vs.tail,
   let r := e.get_app_fn.const_name,
   return format!"{r}:\n{format.join ts}"

open monad

/-- tactic-facing function, similar to `interactive.tactic.generalize` with the
exception that meta variables -/
meta def generalize' (h : name) (v : expr) (x : name) : tactic (expr × expr) :=
do tgt ← target,
   t ← infer_type v,
   tgt' ← do {
     ⟨tgt', _⟩ ← solve_aux tgt (tactic.generalize v x >> target),
     to_expr ``(λ y : %%t, Π x, y = x → %%(tgt'.binding_body.lift_vars 0 1))
     } <|> to_expr ``(λ y : %%t, Π x, %%v = x → %%tgt),
   t ← head_beta (tgt' v) >>= assert h,
   swap,
   r ← mk_eq_refl v,
   solve1 $ tactic.exact (t v r),
   prod.mk <$> tactic.intro x <*> tactic.intro h

private meta def hide_meta_vars (tac : list expr → tactic unit) : tactic unit :=
focus1 $
do tgt ← target >>= instantiate_mvars,
   tactic.change tgt,
   ctx ← local_context,
   let vs := tgt.list_meta_vars,
   vs' ← mmap (λ v,
             do h ← get_unused_name `h,
                x ← get_unused_name `x,
                prod.snd <$> generalize' h v x) vs,
     tac ctx;
     vs'.mmap' (try ∘ tactic.subst)

meta def hide_meta_vars' (tac : itactic) : itactic :=
hide_meta_vars $ λ _, tac

end config

meta def solve_mvar (v : expr) (tac : tactic unit) : tactic unit :=
do gs ← get_goals,
   set_goals [v],
   target >>= instantiate_mvars >>= tactic.change,
   tac, done,
   set_goals $ gs

def list.minimum_on {α β} [decidable_linear_order β] (f : α → β) : list α → list α
| [] := []
| (x :: xs) := prod.snd $ xs.foldl (λ ⟨k,a⟩ b,
     let k' := f b in
     if k < k' then (k,a)
     else if k' < k then (k', [b])
     else (k,b :: a)) (f x, [x])

open format mono_selection

meta def best_match {β} (xs : list expr) (tac : expr → tactic β) : tactic unit :=
do t ← target,
   xs ← xs.mmap (λ x,
     try_core $ prod.mk x <$> solve_aux t (tac x >> get_goals)),
   let xs := xs.filter_map id,
   let r := list.minimum_on (list.length ∘ prod.fst ∘ prod.snd) xs,
   match r with
   | [(_,gs,pr)] :=  tactic.exact pr >> set_goals gs
   | [] := fail "no good match found"
   | _ :=
     do lmms ← r.mmap (λ ⟨l,gs,_⟩,
          do ts ← gs.mmap infer_type,
             msg ← ts.mmap pp,
             pure $ foldl compose "\n\n" (list.intersperse "\n" $ to_fmt l.get_app_fn.const_name :: msg)),
        let msg := foldl compose "" lmms,
        fail format!"ambiguous match: {msg}\n\nTip: try asserting a side condition to distinguish between the lemmas"
   end

meta def mono_aux (dir : parse side) (cfg : mono_cfg := { mono_cfg . }) :
  tactic unit :=
do t ← target >>= instantiate_mvars,
   ns ← get_monotonicity_lemmas t dir,
   asms ← local_context,
   rs ← find_lemma asms t ns,
   focus1 $ () <$ best_match rs (λ law, tactic.refine $ to_pexpr law)

/--
- `mono` applies a monotonicity rule.
- `mono*` applies monotonicity rules repetitively.
- `mono with x ≤ y` or `mono with [0 ≤ x,0 ≤ y]` creates an assertion for the listed
  propositions. Those help to select the right monotonicity rule.
- `mono left` or `mono right` is useful when proving strict orderings:
   for `x + y < w + z` could be broken down into either
    - left:  `x ≤ w` and `y < z` or
    - right: `x < w` and `y ≤ z`
-/
meta def mono (many : parse (tk "*")?) (dir : parse side)
  (hyps : parse $ tk "with" *> pexpr_list_or_texpr <|> pure [])
  (cfg : mono_cfg := { mono_cfg . }) :
  tactic unit :=
do hyps ← hyps.mmap (λ p, to_expr p >>= mk_meta_var),
   hyps.mmap' (λ pr, do h ← get_unused_name `h, note h none pr),
   if many.is_some
     then repeat $ mono_aux dir cfg
     else mono_aux dir cfg,
   gs ← get_goals,
   set_goals $ hyps ++ gs

/--
transforms a goal of the form `f x ≼ f y` into `x ≤ y` using lemmas
marked as `monotonic`.

Special care is taken when `f` is the repeated application of an
associative operator and if the operator is commutative
-/
meta def ac_mono_aux (cfg : mono_cfg := { mono_cfg . }) :
  tactic unit :=
hide_meta_vars $ λ asms,
do try `[dunfold has_sub.sub algebra.sub],
   tgt ← target >>= instantiate_mvars,
   (l,r,id_rs,g) ← ac_monotonicity_goal cfg tgt
             <|> fail "monotonic context not found",
   ns ← get_monotonicity_lemmas tgt both,
   p ← mk_pattern g,
   rules ← find_rule asms ns p <|> fail "no applicable rules found",
   when (rules = []) (fail "no applicable rules found"),
   err ← format.join <$> mmap side_conditions rules,
   focus1 $ best_match rules (λ rule, do
     t₀ ← mk_meta_var `(Prop),
     v₀ ← mk_meta_var t₀,
     t₁ ← mk_meta_var `(Prop),
     v₁ ← mk_meta_var t₁,
     tactic.refine $ ``(apply_rel %%(g.rel_def) %%l %%r %%rule %%v₀ %%v₁),
     solve_mvar v₀ (try (any_of id_rs rewrite_target) >>
             ( done <|>
               refl <|>
               ac_refl <|>
               `[simp only [is_associative.assoc]]) ),
     solve_mvar v₁ (try (any_of id_rs rewrite_target) >>
             ( done <|>
               refl <|>
               ac_refl <|>
               `[simp only [is_associative.assoc]]) ),
     n ← num_goals,
     iterate_exactly (n-1) (try $ solve1 $ apply_instance <|>
       tactic.solve_by_elim {assumptions := pure asms}))

open sum nat

/-- (repeat_until_or_at_most n t u): repeat tactic `t` at most n times or until u succeeds -/
meta def repeat_until_or_at_most : nat → tactic unit → tactic unit → tactic unit
| 0        t _ := fail "too many applications"
| (succ n) t u := u <|> (t >> repeat_until_or_at_most n t u)

meta def repeat_until : tactic unit → tactic unit → tactic unit :=
repeat_until_or_at_most 100000

@[derive _root_.has_reflect]
inductive rep_arity : Type
| one | exactly (n : ℕ) | many

meta def repeat_or_not : rep_arity → tactic unit → option (tactic unit) → tactic unit
 | rep_arity.one  tac none := tac
 | rep_arity.many tac none := repeat tac
 | (rep_arity.exactly n) tac none := iterate_exactly n tac
 | rep_arity.one  tac (some until) := tac >> until
 | rep_arity.many tac (some until) := repeat_until tac until
 | (rep_arity.exactly n) tac (some until) := iterate_exactly n tac >> until

meta def assert_or_rule : lean.parser (pexpr ⊕ pexpr) :=
(tk ":=" *> inl <$> texpr <|> (tk ":" *> inr <$> texpr))

meta def arity : lean.parser rep_arity :=
rep_arity.many <$ tk "*" <|>
rep_arity.exactly <$> (tk "^" *> small_nat) <|>
pure rep_arity.one

/--
`ac_mono` reduces the `f x ⊑ f y`, for some relation `⊑` and a
monotonic function `f` to `x ≺ y`.

`ac_mono*` unwraps monotonic functions until it can't.

`ac_mono^k`, for some literal number `k` applies monotonicity `k`
times.

`ac_mono h`, with `h` a hypothesis, unwraps monotonic functions
and uses `h` to solve the remaining goal. Can be combined with * or
^k: `ac_mono* h`

`ac_mono : p` asserts `p` and uses it to discharge the goal result
unwrapping a series of monotonic functions. Can be combined with * or
^k: `ac_mono* : p`

In the case where `f` is an associative or commutative operator,
`ac_mono` will consider any possible permutation of its arguments
and use the one the minimizes the difference between the left-hand
side and the right-hand side.

TODO(Simon): with `ac_mono h` and `ac_mono : p` split the remaining
  gaol if the provided rule does not solve it completely.
-/
meta def ac_mono (rep : parse arity) :
         parse assert_or_rule? →
         opt_param mono_cfg { mono_cfg . } →
         tactic unit
 | none opt := focus1 $ repeat_or_not rep (ac_mono_aux opt) none
 | (some (inl h)) opt :=
do focus1 $ repeat_or_not rep (ac_mono_aux opt) (some $ done <|> to_expr h >>= ac_refine)
 | (some (inr t)) opt :=
do h ← i_to_expr t >>= assert `h,
   tactic.swap,
   focus1 $ repeat_or_not rep (ac_mono_aux opt) (some $ done <|> ac_refine h)

attribute [mono] and.imp or.imp

end tactic.interactive