import vc0.basic

namespace c0
open ast

namespace value

theorem step_comp.determ {op v₁ v₂ b₁ b₂}
  (h₁ : step_comp op v₁ v₂ b₁)
  (h₂ : step_comp op v₁ v₂ b₂) : b₁ = b₂ :=
begin
  suffices : ∀ {op' v₁' v₂'} (e : (op, v₁, v₂) = (op', v₁', v₂'))
    (h₂ : step_comp op' v₁' v₂' b₂), b₁ = b₂,
  from this rfl h₂,
  clear h₂, intros,
  induction h₁; induction h₂; cases e; refl
end

theorem step_binop.determ {op v₁ v₂ w₁ w₂}
  (h₁ : step_binop op v₁ v₂ w₁) (h₂ : step_binop op v₁ v₂ w₂) : w₁ = w₂ :=
begin
  generalize_hyp eo : op = op' at h₂,
  generalize_hyp e₁ : v₁ = v₁' at h₂,
  generalize_hyp e₂ : v₂ = v₂' at h₂,
  induction h₁; induction h₂; cases eo; cases e₁; cases e₂; try {refl},
  cases h₁_a.determ h₂_a, refl
end

theorem step_unop.determ {op v w₁ w₂}
  (h₁ : step_unop op v w₁) (h₂ : step_unop op v w₂) : w₁ = w₂ :=
by cases h₁; cases h₂; refl

theorem default.determ {Γ} (ok : okind Γ) {ts v₁ v₂}
  (h₁ : default Γ ts v₁)
  (h₂ : default Γ ts v₂) : v₁ = v₂ :=
begin
  induction h₁ generalizing v₂; try {cases h₂}; try {refl},
  { cases get_sdef_determ ok h₁_a h₂_a,
    exact h₁_ih h₂_a_1 },
  { generalize_hyp e : alist.cons h₁_Δ h₁_x h₁_τ h₁_h = Δ' at h₂,
    cases h₂, {cases e},
    rcases alist.cons_inj e with ⟨⟨⟩, rfl⟩,
    cases h₁_ih_a h₂_a, cases h₁_ih_a_1 h₂_a_1, refl }
end

theorem is_nth.determ {n v v₁ v₂}
  (h₁ : is_nth n v v₁) (h₂ : is_nth n v v₂) : v₁ = v₂ :=
by induction h₁ generalizing v₂; cases h₂;
   [refl, {cases h₁_ih h₂_a, refl}]

end value

namespace addr

theorem get.determ {H η a v₁ v₂}
  (h₁ : get H η a v₁) (h₂ : get H η a v₂) : v₁ = v₂ :=
begin
  induction h₁ generalizing v₂; cases h₂,
  { exact option.mem_unique h₁_a h₂_a },
  { exact option.mem_unique h₁_a h₂_a },
  { cases h₁_ih h₂_a_1, refl },
  { cases h₁_ih h₂_a_1, refl },
  { cases h₁_ih h₂_a_1, exact h₁_a_2.determ h₂_a_2 },
  { cases value.of_map_inj (h₁_ih h₂_a_1),
    exact option.mem_unique h₁_a_2 h₂_a_2 }
end

theorem get_len.determ {H η a v₁ v₂}
  (h₁ : get_len H η a v₁)
  (h₂ : get_len H η a v₂) : v₁ = v₂ :=
by cases h₁; cases h₂; cases h₁_a_1.determ h₂_a_1; refl

theorem update_at.determ
  {α} {R : α → α → Prop} (Rd : ∀ x y₁ y₂, R x y₁ → R x y₂ → y₁ = y₂) :
  ∀ {n l l₁ l₂}, list.update_at R n l l₁ → list.update_at R n l l₂ → l₁ = l₂
| _ _ _ _ (@list.update_at.one _ _ a b l r) (@list.update_at.one _ _ _ b' _ r') :=
  by rw Rd _ _ _ r r'
| _ _ _ _ (@list.update_at.cons _ _ n a l r h) (@list.update_at.cons _ _ _ _ _ r' h') :=
  by rw update_at.determ h h'

theorem at_head.determ
  {R : value → value → Prop} (Rd : ∀ x y₁ y₂, R x y₁ → R x y₂ → y₁ = y₂)
  (x y₁ y₂) (h₁ : value.at_head R x y₁) (h₂ : value.at_head R x y₂) : y₁ = y₂ :=
by cases h₁; cases h₂; rw Rd _ _ _ h₁_a h₂_a

theorem at_tail.determ
  {R : value → value → Prop} (Rd : ∀ x y₁ y₂, R x y₁ → R x y₂ → y₁ = y₂)
  (x y₁ y₂) (h₁ : value.at_tail R x y₁) (h₂ : value.at_tail R x y₂) : y₁ = y₂ :=
by cases h₁; cases h₂; rw Rd _ _ _ h₁_a h₂_a

theorem at_nth'.determ
  {R : value → value → Prop} (Rd : ∀ x y₁ y₂, R x y₁ → R x y₂ → y₁ = y₂)
  : ∀ {n} x y₁ y₂, value.at_nth' R n x y₁ → value.at_nth' R n x y₂ → y₁ = y₂
| 0     := at_head.determ Rd
| (n+1) := at_tail.determ at_nth'.determ

theorem at_nth.determ
  {R : value → value → Prop} (Rd : ∀ x y₁ y₂, R x y₁ → R x y₂ → y₁ = y₂)
  {n} (x y₁ y₂) (h₁ : value.at_nth R n x y₁) (h₂ : value.at_nth R n x y₂) : y₁ = y₂ :=
by cases h₁; cases h₂; rw at_nth'.determ Rd _ _ _ h₁_a_1 h₂_a_1

theorem at_field.determ
  {R : value → value → Prop} (Rd : ∀ x y₁ y₂, R x y₁ → R x y₂ → y₁ = y₂)
  {f} (x y₁ y₂) (h₁ : value.at_field R f x y₁) (h₂ : value.at_field R f x y₂) : y₁ = y₂ :=
begin
  rcases h₁ with ⟨_, _, vs, x, y, r, m, e, rfl⟩,
  rcases h₂ with ⟨_, _, vs', x', y', r', m', e', rfl⟩,
  cases value.of_map_inj (e.symm.trans e'),
  cases option.mem_unique m m',
  rw Rd _ _ _ r r'
end

theorem update.determ {H η a H₁ η₁ H₂ η₂}
  {R : value → value → Prop} (Rd : ∀ x y₁ y₂, R x y₁ → R x y₂ → y₁ = y₂)
  (h₁ : update H η R a H₁ η₁)
  (h₂ : update H η R a H₂ η₂) : (H₁, η₁) = (H₂, η₂) :=
begin
  induction h₁ generalizing H₂ η₂; cases h₂,
  { cases update_at.determ Rd h₁_a h₂_a, refl },
  { substs h₁_η' η₂, cases option.mem_unique h₁_a h₂_a,
    cases Rd _ _ _ h₁_a_1 h₂_a_1, refl },
  { exact h₁_ih (at_head.determ Rd) h₂_a_1 },
  { exact h₁_ih (at_tail.determ Rd) h₂_a_1 },
  { exact h₁_ih (at_nth.determ Rd) h₂_a_1 },
  { exact h₁_ih (at_field.determ Rd) h₂_a_1 }
end

theorem eq.determ {v : value} (_ : value) : ∀ y₁ y₂, v = y₁ → v = y₂ → y₁ = y₂
| _ _ rfl h := h

end addr

theorem step_deref.determ {C a K s₁ s₂}
  (h₁ : step_deref C a K s₁) (h₂ : step_deref C a K s₂) : s₁ = s₂ :=
by cases h₁; cases h₂; [refl, {cases h₁_a_1.determ h₂_a_1, refl}]

theorem step_ret.determ {C v s₁ s₂}
  (h₁ : step_ret C v s₁) (h₂ : step_ret C v s₂) : s₁ = s₂ :=
by cases h₁; cases h₂; refl

theorem step_call.determ {Γ : ast} (ok : Γ.okind)
  {vs xτs η₁ η₂}
  (h₁ : step_call xτs vs η₁) (h₂ : step_call xτs vs η₂) : η₁ = η₂ :=
begin
  induction h₁ with Δ x τ v vs η h sc IH generalizing η₂,
  { cases h₂, refl },
  { generalize_hyp e₁ : alist.cons Δ x τ _ = Δ' at h₂,
    cases h₂, rcases alist.cons_inj e₁ with ⟨⟨⟩, rfl⟩,
    cases IH h₂_a, refl }
end

theorem step_alloc.determ {C v K s₁ s₂}
  (sa₁ : step_alloc C v K s₁) (sa₂ : step_alloc C v K s₂) : s₁ = s₂ :=
by cases sa₁; cases sa₂; refl

theorem index_not_lt_zero {i : int32} {n : ℕ} (e : (i : ℤ) = n) : ¬ i < 0 :=
not_lt_of_le $ by rw [← int32.coe_le, e, int32.coe_zero]; apply int.coe_nat_nonneg

theorem index_not_lt_zero_or {i : int32} {j n : ℕ}
  (e : (i : ℤ) = j) (lt : j < n) : ¬ (i < 0 ∨ (n : ℤ) ≤ i)
| (or.inl h) := index_not_lt_zero e h
| (or.inr h) := not_lt_of_le h $ by rwa [e, int.coe_nat_lt]

inductive io_equiv : io → state → io → state → Prop
| none {s} : io_equiv none s none s
| some {i o₁ o₂ s₁ s₂} : (o₁ = o₂ → s₁ = s₂) →
  io_equiv (some (i, o₁)) s₁ (some (i, o₂)) s₂

theorem determ {Γ : ast} (ok : Γ.ok) {s o₁ s₁ o₂ s₂}
  (h₁ : step Γ s o₁ s₁) (h₂ : step Γ s o₂ s₂) : io_equiv o₁ s₁ o₂ s₂ :=
begin
  cases h₁,
  case c0.step.asgn_var₁ : C lv x e K h {
    cases h₂,
    case c0.step.asgn₁ : _ _ _ _ h' { rw h' at h, cases h },
    case c0.step.asgn_var₁ : _ _ _ _ y h' {
      cases option.mem_unique h h', constructor } },
  case c0.step.asgn₁ : C lv e K h {
    cases h₂,
    case c0.step.asgn_var₁ : _ _ _ _ x h' { rw h at h', cases h' },
    case c0.step.asgn₁ : h' { constructor } },
  case c0.step.asgn₃ : H H' S η η' a v K h {
    cases h₂,
    rcases h.determ addr.eq.determ h₂_a_1 with ⟨rfl, rfl⟩,
    constructor },
  case c0.step.asnop₂ : _ C a op e K h {
    cases h₂, cases step_deref.determ h h₂_a_1, constructor },
  case c0.step.ret₂ : _ C v h {
    cases h₂, cases h.determ h₂_a, constructor },
  case c0.step.ret_none : _ C v h {
    cases h₂, cases h.determ h₂_a, constructor },
  case c0.step.nop₁ : _ C h {
    cases h₂, cases h.determ h₂_a, constructor },
  case c0.step.var : C i v K h {
    cases h₂, cases option.mem_unique h h₂_a, constructor },
  case c0.step.binop₃ : C op v₁ v₂ v K h {
    cases h₂; cases h.determ h₂_a; constructor },
  case c0.step.binop_err : C op v₁ v₂ err K h {
    cases h₂; cases h.determ h₂_a; constructor },
  case c0.step.unop₂ : C op v v₁ K h {
    cases h₂, cases h.determ h₂_a, constructor },
  case c0.step.call₂ : H S η η₁ f τ₁ xτs₁ s₁ vs K hb₁ sc₁ {
    cases h₂,
    case c0.step.call₂ : _ _ _ _ _ _ η₂ τ₂ xτs₂ s₂ hb₂ sc₂ {
      cases hb₁.determ ok.ind hb₂,
      cases sc₁.determ ok.ind sc₂,
      constructor },
    case c0.step.call_extern : _ _ _ _ _ _ H' v' h' {
      cases ok.header_no_def h' ⟨_, _, _, hb₁⟩ } },
  case c0.step.call_extern : H S η f vs H' v K h {
    cases h₂,
    case c0.step.call₂ : _ _ _ _ _ _ η₂ τ₂ xτs₂ s₂ hb₂ sc₂ {
      cases ok.header_no_def h ⟨_, _, _, hb₂⟩ },
    case c0.step.call_extern : H' v' h' {
      constructor, rintro ⟨⟩, refl } },
  case c0.step.deref' : _ C a K h {
    cases h₂, cases h.determ h₂_a_1, constructor },
  case c0.step.alloc_ref : _ C τ τ' v K tτ v0 sa {
    cases h₂,
    cases tτ.determ ok.ind h₂_a,
    cases v0.determ ok.ind h₂_a_1,
    cases sa.determ h₂_a_2, constructor },
  case c0.step.alloc_arr₁ : C τ τ' e K tτ {
    cases h₂, cases tτ.determ ok.ind h₂_a, constructor },
  case c0.step.alloc_arr₂ : _ C τ v K i n e v0 sa {
    cases h₂,
    case c0.step.alloc_arr₂ : _ _ _ _ _ v' n' e' v0' sa' {
      cases v0.determ ok.ind v0',
      cases int.coe_nat_inj (e.symm.trans e'),
      cases sa.determ sa', constructor },
    case c0.step.alloc_arr_err : _ _ _ _ h' {
      cases index_not_lt_zero e h' } },
  case c0.step.alloc_arr_err : C τ i K h {
    cases h₂,
    case c0.step.alloc_arr₂ : _ _ _ _ _ v' n' e' v0' sa' {
      cases index_not_lt_zero e' h },
    case c0.step.alloc_arr_err : h' { constructor } },
  case c0.step.addr_index₃ : C a n K i j hl e lt {
    cases h₂,
    case c0.step.addr_index₃ : _ _ _ _ n' j' hl' e' lt' {
      cases int.coe_nat_inj (e.symm.trans e'), constructor },
    case c0.step.addr_index_err₂ : _ _ _ _ n' hl' lt' {
      cases hl.determ hl',
      cases index_not_lt_zero_or e lt lt' } },
  case c0.step.addr_index_err₂ : C a n K i hl lt {
    cases h₂,
    case c0.step.addr_index₃ : _ _ _ _ n' j' hl' e' lt' {
      cases hl.determ hl',
      cases index_not_lt_zero_or e' lt' lt },
    case c0.step.addr_index_err₂ : n' hl' lt' { constructor } },
  all_goals {{ cases h₂; constructor }}
end

theorem determ' {Γ : ast} (ok : Γ.ok) {s o s₁ s₂}
  (h₁ : step Γ s o s₁) (h₂ : step Γ s o s₂) : s₁ = s₂ :=
by cases determ ok h₁ h₂; [refl, exact a rfl]

end c0


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.abelian.basic
import category_theory.preadditive.opposite
import category_theory.limits.opposites
import category_theory.limits.constructions.limits_of_products_and_equalizers

/-!
# The opposite of an abelian category is abelian.
-/

noncomputable theory

namespace category_theory

open category_theory.limits

variables (C : Type*) [category C] [abelian C]

local attribute [instance]
  finite_limits_from_equalizers_and_finite_products
  finite_colimits_from_coequalizers_and_finite_coproducts
  has_finite_limits_opposite has_finite_colimits_opposite has_finite_products_opposite

instance : abelian Cᵒᵖ :=
{ normal_mono_of_mono := λ X Y f m, by exactI
    normal_mono_of_normal_epi_unop _ (normal_epi_of_epi f.unop),
  normal_epi_of_epi := λ X Y f m, by exactI
    normal_epi_of_normal_mono_unop _ (normal_mono_of_mono f.unop), }

section

variables {C} {X Y : C} (f : X ⟶ Y) {A B : Cᵒᵖ} (g : A ⟶ B)

-- TODO: Generalize (this will work whenever f has a cokernel)
-- (The abelian case is probably sufficient for most applications.)
/-- The kernel of `f.op` is the opposite of `cokernel f`. -/
@[simps]
def kernel_op_unop : (kernel f.op).unop ≅ cokernel f :=
{ hom := (kernel.lift f.op (cokernel.π f).op $ by simp [← op_comp]).unop,
  inv := cokernel.desc f (kernel.ι f.op).unop $
    by { rw [← f.unop_op, ← unop_comp, f.unop_op], simp },
  hom_inv_id' := begin
    rw [← unop_id, ← (cokernel.desc f _ _).unop_op, ← unop_comp],
    congr' 1,
    dsimp,
    ext,
    simp [← op_comp],
  end,
  inv_hom_id' := begin
    dsimp,
    ext,
    simp [← unop_comp],
  end }

-- TODO: Generalize (this will work whenever f has a kernel)
-- (The abelian case is probably sufficient for most applications.)
/-- The cokernel of `f.op` is the opposite of `kernel f`. -/
@[simps]
def cokernel_op_unop : (cokernel f.op).unop ≅ kernel f :=
{ hom := kernel.lift f (cokernel.π f.op).unop $
    by { rw [← f.unop_op, ← unop_comp, f.unop_op], simp },
  inv := (cokernel.desc f.op (kernel.ι f).op $ by simp [← op_comp]).unop,
  hom_inv_id' := begin
    rw [← unop_id, ← (kernel.lift f _ _).unop_op, ← unop_comp],
    congr' 1,
    dsimp,
    ext,
    simp [← op_comp],
  end,
  inv_hom_id' := begin
    dsimp,
    ext,
    simp [← unop_comp],
  end }

/-- The kernel of `g.unop` is the opposite of `cokernel g`. -/
@[simps]
def kernel_unop_op : opposite.op (kernel g.unop) ≅ cokernel g :=
(cokernel_op_unop g.unop).op

/-- The cokernel of `g.unop` is the opposite of `kernel g`. -/
@[simps]
def cokernel_unop_op : opposite.op (cokernel g.unop) ≅ kernel g :=
(kernel_op_unop g.unop).op

lemma cokernel.π_op : (cokernel.π f.op).unop =
  (cokernel_op_unop f).hom ≫ kernel.ι f ≫ eq_to_hom (opposite.unop_op _).symm :=
by simp [cokernel_op_unop]

lemma kernel.ι_op : (kernel.ι f.op).unop =
  eq_to_hom (opposite.unop_op _) ≫ cokernel.π f ≫ (kernel_op_unop f).inv :=
by simp [kernel_op_unop]

/-- The kernel of `f.op` is the opposite of `cokernel f`. -/
@[simps]
def kernel_op_op : kernel f.op ≅ opposite.op (cokernel f) :=
(kernel_op_unop f).op.symm

/-- The cokernel of `f.op` is the opposite of `kernel f`. -/
@[simps]
def cokernel_op_op : cokernel f.op ≅ opposite.op (kernel f) :=
(cokernel_op_unop f).op.symm

/-- The kernel of `g.unop` is the opposite of `cokernel g`. -/
@[simps]
def kernel_unop_unop : kernel g.unop ≅ (cokernel g).unop :=
(kernel_unop_op g).unop.symm

lemma kernel.ι_unop : (kernel.ι g.unop).op =
  eq_to_hom (opposite.op_unop _) ≫ cokernel.π g ≫ (kernel_unop_op g).inv :=
by simp

lemma cokernel.π_unop : (cokernel.π g.unop).op =
  (cokernel_unop_op g).hom ≫ kernel.ι g ≫ eq_to_hom (opposite.op_unop _).symm :=
by simp

/-- The cokernel of `g.unop` is the opposite of `kernel g`. -/
@[simps]
def cokernel_unop_unop : cokernel g.unop ≅ (kernel g).unop :=
(cokernel_unop_op g).unop.symm

end

end category_theory


import tactic.pretty_cases
import data.list.perm

example {α} (xs ys : list α) (h : xs ~ ys) : true :=
begin
  induction h,
  do { x ← tactic.pretty_cases_advice,
       guard (x =
"Try this:
  case list.perm.nil
  { admit },
  case list.perm.cons : h_x h_l₁ h_l₂ h_ᾰ h_ih
  { admit },
  case list.perm.swap : h_x h_y h_l
  { admit },
  case list.perm.trans : h_l₁ h_l₂ h_l₃ h_ᾰ h_ᾰ_1 h_ih_ᾰ h_ih_ᾰ_1
  { admit }"
) <|> fail!"expecting: {repr x}" },
  all_goals { trivial }
end

example {α} (xs ys : list α) (h : xs ~ ys) : true :=
begin
  cases h,
  do { x ← tactic.pretty_cases_advice,
       guard (x =
"Try this:
  case list.perm.nil
  { admit },
  case list.perm.cons : h_x h_l₁ h_l₂ h_ᾰ
  { admit },
  case list.perm.swap : h_x h_y h_l
  { admit },
  case list.perm.trans : xs h_l₂ ys h_ᾰ h_ᾰ_1
  { admit }") },
  all_goals { trivial }
end


set_option pp.analyze false

example (p : (n : Nat) → Fin n → Prop)
        (n : Nat)
        (v : Fin n)
        : p n.succ v.succ := by
  generalize h₁ : n.succ = n', h₂ : v.succ = v'
  trace_state
  admit


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (x : ℕ) (hp : prime p) (hc : nat.gcd x p = 1) :
  is_unit (p : int) (x : int) :=
begin
  -- Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$
  have h1 : ¬ is_unit (p : int) (x : int) → nat.gcd x p ≠ 1, from sorry,

  -- Thus assume that $\Vert x \Vert \neq 1$
  have h2 : ¬ (norm_int p (x : int) = 1), from sorry,

  -- But this must imply that $p | x$, from an earlier exercise
  have h3 : ∃ k : ℕ, p * k = x, from sorry,

  -- Thus $x$ is not coprime to $p$
  have h4 : nat.gcd x p ≠ 1, from sorry,

  show is_unit (p : int) (x : int), from sorry,
end

--OUTPUT 2
theorem p_adic_units (p x : ℕ) : coprime p x → (x : ℤp) ∈ units (ℤp) :=
begin
  -- Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
  assume (h1 : ¬ (x : ℤp) ∈ units (ℤp)) (h2 : coprime p x),
  have h3 : (x : ℤp) ∉ units ℤp, from sorry,
  have h4 : ¬(x : ℤp) ∈ (units ℤp), from sorry,
  have h5 : norm ((x : ℤp)) = 0, from sorry,
  have h6 : 0 = 1, from sorry,
  have h7 : false, from sorry,
  have h8 : 1 < p, from sorry,
  have h9 : (x : ℤp) ∉ units ℤp, from sorry,

  -- We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$.
  have h10 : ¬norm ((x : ℤp)) = 1, from sorry,
  have h11 : norm ((x : ℤp)) ≠ 1, from sorry,
  have h12 : ¬norm ((x : ℤp)) = 1, from sorry,

  -- Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
  have h13 : norm ((x : ℤp)) ≤ 1, from sorry,
  have h14 : norm ((x : ℤp)) < 1, from sorry,

  -- But this must imply that $p | x$.
  have h15 : p ∣ x, sorry,
  have h16 : p ∣ x, sorry,
  have h17 : ¬coprime p x, sorry,
  have h18 : ¬coprime p x, sorry,

  -- This completes our proof.
  show false, from sorry,
end

--OUTPUT 3
theorem unit_in_Z_p {p : ℕ} (hp : is_prime p) (coprime_p : p.coprime x) : x ∈ units (ℤ/pℤ) :=
begin
  have h : x ∉ units ((ℤ/pℤ)), from x.nat_abs.not_unit_of_non_unit_of_not_dvd coprime_p,
  have h2 : ∃ k, x.nat_abs.val / p^k = 1, from
    (show x.nat_abs.val / p^k = 1, from dec_trivial),
  have h3 : (1 : ℝ) = x.nat_abs.val / p^k,
    from exists.elim h2 (λ k : ℕ, (λ h2 : x.nat_abs.val / p^k = 1, h2)),
  have h4 : 1 ≤ x.nat_abs.val / p^k, from le_of_eq h3,
  have h5 : x.nat_abs.val / p^k = 1, from eq_one_of_one_le h4,
  have h6 : x.nat_abs.val / p^k ≠ 1, from h,
  have h7 : 1 < x.nat_abs.val / p^k, from lt_of_not_ge h6,
  have h8 : x.nat_abs.val / p^k < 0, from lt_of_lt_of_le h7 one_le_zero,
  sorry,
end

--OUTPUT 4
theorem p_adic_units (p : ℕ) (hp : p.prime) (x : ℕ) : x.coprime p → x ∈ (p : ℕ)⁻¹ :=
begin
  assume hx : x.coprime p,
  have one_ne_zero : (1 : ℕ) ≠ 0, from dec_trivial,
  have p_prime_pos : p > 0, sorry,
  have hor : x = 0 ∨ x ≠ 0, from dec_em x,
  cases hor with hor0 hor1,
  {have hx_eq_0 : x = 0, from hor0,
   have hp_dvd_0 : p ∣ 0, from sorry,
   have h : false, from sorry,
  rw hx_eq_0 at h, exact h,
  },
  {have hx_ne_0 : x ≠ 0, from hor1,
   have h2 : p ∣ x → ¬x.coprime p, from sorry,
   assume hp_dvd_x,
   have : ¬x.coprime p, from sorry,
   exact this hx,
  }
end

--OUTPUT 5
theorem p_adic_units {p : ℕ} (hp : p.prime) {x : ℕ} (hx : coprime x p) : is_unit (p_adic_int.mk_val_spec x p) :=
begin
  suffices : ¬ is_unit (p_adic_int.mk_val_spec x p) → ¬ coprime x p, from
    by { assume : ¬ coprime x p, show is_unit (p_adic_int.mk_val_spec x p), from this.elim (assume : ¬ is_unit (p_adic_int.mk_val_spec x p), this)},
  assume : ¬ is_unit (p_adic_int.mk_val_spec x p),
    have h3 : ¬ (norm (p_adic_int.mk_val_spec x p) = 1), from sorry, -- norm of any element of Zp is 1 iff the element is a unit
    have h4 : ¬ norm (p_adic_int.mk_val_spec x p) < 1, from sorry, -- norm of any element of Zp is less than or equal to 1.
    have h5 : ∀ {a b : ℕ}, a < b → a ∣ b, from sorry,
    have h6 : (norm (p_adic_int.mk_val_spec x p) < 1) → (norm (p_adic_int.mk_val_spec x p) ∣ x), from sorry, -- norm of an element of Zp divides the associated natural number
    have h7 : norm (p_adic_int.mk_val_spec x p) ∣ x, from sorry,
  show ¬ coprime x p, from sorry,
end

--OUTPUT 6
theorem padicunits {p : ℕ} [hp : p.prime] (x : ℕ) [hx : coprime p x] : (x : ℤ p) * (x : ℤ p) = (1 : ℤ p) :=
begin
  -- prove the contrapositive
  have h : x ∉ unitsofintp, from by {
    unfold unitsofintp,
    simp,
  },
  have h1 : x ∉ coprime gcd p, from sorry,
  show x ∉ coprime p, by {
    apply coprime.def,
  },
end

--OUTPUT 7
theorem if_coprime_padic_unit (p x : ℕ) : coprime p x → x ∈ units (padic_int p) :=
begin
intro h,
have h1 : nat_abs x = x, from nat.abs_of_coprime h,
have h2 : ∀ z, z > 0 → padic_norm p (x : padic_int p) = 1 ↔ z ∈ units ℤ, from sorry,
have h3 : ¬ (x : padic_int p) ∈ units padic_int p, from sorry,
have h4 : padic_norm p (x : padic_int p) ≠ 1, from sorry,
have h5 : padic_norm p (x : padic_int p) < 1, from sorry,
have h6 : ∀ (z : ℚ), (z : ℚ) ≠ 1  →  ¬is_unit z, from sorry,
have h7 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h8 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h9 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h10 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h11 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h12 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h13 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h14 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h15 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h16 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h17 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h18 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h19 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h20 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h21 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h22 : ∀ (n m : ℕ), n < m → n ∈ range m → n < m, from sorry,
have h23 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h24 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h25 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h26 : ∀ a b c : ℕ, a < b → c < b → c ∈ range b → c < b, from sorry,
have h27 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h28 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h29 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,

have h30 : ∀ n m : ℕ, n < m → n ∈ range m → n < m, from sorry,
have h31 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h32 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h33 : ∀ a b c : ℕ, a < b → c < b → c ∈ range b → c < b, from sorry,
have h34 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h35 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h36 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h37 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,

have h38 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h39 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h40 : ∀ a : ℕ, a ∈ range p → ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h41 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h42 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h43 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h44 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h45 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,

have h46 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h47 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h48 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h49 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h50 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h51 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h52 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h53 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,

have h54 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h55 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h56 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h57 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h58 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h59 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h60 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h61 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,

have h62 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h63 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h64 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h65 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h66 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h67 : ¬is_unit (padic_norm p (x : padic_int p)), from sorry,
have h68 : ¬is_unit (padic_norm p (x : padic_int p
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem p_adic_units (p : ℕ) (x : ℕ) : coprime p x → (∃ y : ℕ, x*y = 1) → ∃ y : ℕ, x*y = 1 :=
begin
  assume (h1 : coprime p x) (h2 : ∃ y : ℕ, x*y = 1),
  have h3 : ∃ y : ℕ, x*y = 1, from by sorry,
  show ∃ y : ℕ, x*y = 1, from sorry,
end

--OUTPUT 9
theorem p_adic_units (p : ℕ) (x : ℕ) (h : coprime p x) : x ∈ units ℤₚ :=
begin
  -- The contrapositive of the statement
  push_neg at h,
  -- x is not coprime to p
  have h1 : p ∣ x ∨ p ∣ x, from sorry,
  -- Either way x is not coprime to p
  have h2 : ¬ (x ∈ coprime p), from sorry,
  -- x must be a unit of $\mathbb{Z}_p$ for the statement to be true
  have h3 : x ∈ units ℤₚ, from sorry,

  show x ∈ units ℤₚ, from sorry,
end

--OUTPUT 10
theorem p_adic_units {p : ℕ} (h1 : prime p) (x : ℕ) (h2 : nat.gcd x p = 1) : is_unit (Zp x) :=
begin
  sorry,
end

/- 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
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from sorry,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from sorry,
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from sorry,
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
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by sorry
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by sorry
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by sorry,
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
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  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) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Meta.Match.Match
import Lean.Elab.PreDefinition.Structural.Basic

namespace Lean.Elab.Structural
open Meta

private def throwToBelowFailed : MetaM α :=
  throwError "toBelow failed"

/- See toBelow -/
private partial def toBelowAux (C : Expr) : Expr → Expr → Expr → MetaM Expr
  | belowDict, arg, F => do
    let belowDict ← whnf belowDict
    trace[Elab.definition.structural] "belowDict: {belowDict}, arg: {arg}"
    match belowDict with
    | Expr.app (Expr.app (Expr.const `PProd _ _) d1 _) d2 _ =>
      (do toBelowAux C d1 arg (← mkAppM `PProd.fst #[F]))
      <|>
      (do toBelowAux C d2 arg (← mkAppM `PProd.snd #[F]))
    | Expr.app (Expr.app (Expr.const `And _ _) d1 _) d2 _ =>
      (do toBelowAux C d1 arg (← mkAppM `And.left #[F]))
      <|>
      (do toBelowAux C d2 arg (← mkAppM `And.right #[F]))
    | _ => forallTelescopeReducing belowDict fun xs belowDict => do
      let argArgs := arg.getAppArgs
      unless argArgs.size >= xs.size do throwToBelowFailed
      let n := argArgs.size
      let argTailArgs := argArgs.extract (n - xs.size) n
      let belowDict := belowDict.replaceFVars xs argTailArgs
      match belowDict with
      | Expr.app belowDictFun belowDictArg _ =>
        unless belowDictFun.getAppFn == C do throwToBelowFailed
        unless ← isDefEq belowDictArg arg do throwToBelowFailed
        pure (mkAppN F argTailArgs)
      | _ => throwToBelowFailed

/- See toBelow -/
private def withBelowDict (below : Expr) (numIndParams : Nat) (k : Expr → Expr → MetaM α) : MetaM α := do
  let belowType ← inferType below
  trace[Elab.definition.structural] "belowType: {belowType}"
  belowType.withApp fun f args => do
    let motivePos := numIndParams + 1
    unless motivePos < args.size do throwError "unexpected 'below' type{indentExpr belowType}"
    let pre := mkAppN f (args.extract 0 numIndParams)
    let preType ← inferType pre
    forallBoundedTelescope preType (some 1) fun x _ => do
      let motiveType ← inferType x[0]
      let C ← mkFreshUserName `C
      withLocalDeclD C motiveType fun C =>
        let belowDict := mkApp pre C
        let belowDict := mkAppN belowDict (args.extract (numIndParams + 1) args.size)
        k C belowDict

/-
  `below` is a free variable with type of the form `I.below indParams motive indices major`,
  where `I` is the name of an inductive datatype.

  For example, when trying to show that the following function terminates using structural recursion
  ```lean
  def addAdjacent : List Nat → List Nat
  | []       => []
  | [a]      => [a]
  | a::b::as => (a+b) :: addAdjacent as
  ```
  when we are visiting `addAdjacent as` at `replaceRecApps`, `below` has type
  `@List.below Nat (fun (x : List Nat) => List Nat) (a::b::as)`
  The motive `fun (x : List Nat) => List Nat` depends on the actual function we are trying to compute.
  So, we first replace it with a fresh variable `C` at `withBelowDict`.
  Recall that `brecOn` implements course-of-values recursion, and `below` can be viewed as a dictionary
  of the "previous values".
  We search this dictionary using the auxiliary function `toBelowAux`.
  The dictionary is built using the `PProd` (`And` for inductive predicates).
  We keep searching it until we find `C recArg`, where `C` is the auxiliary fresh variable created at `withBelowDict`.  -/
private partial def toBelow (below : Expr) (numIndParams : Nat) (recArg : Expr) : MetaM Expr := do
  withBelowDict below numIndParams fun C belowDict =>
    toBelowAux C belowDict recArg below

private partial def replaceRecApps (recFnName : Name) (recArgInfo : RecArgInfo) (below : Expr) (e : Expr) : M Expr :=
  let rec loop (below : Expr) (e : Expr) : M Expr := do
    match e with
    | Expr.lam n d b c =>
      withLocalDecl n c.binderInfo (← loop below d) fun x => do
        mkLambdaFVars #[x] (← loop below (b.instantiate1 x))
    | Expr.forallE n d b c =>
      withLocalDecl n c.binderInfo (← loop below d) fun x => do
        mkForallFVars #[x] (← loop below (b.instantiate1 x))
    | Expr.letE n type val body _ =>
      withLetDecl n (← loop below type) (← loop below val) fun x => do
        mkLetFVars #[x] (← loop below (body.instantiate1 x))
    | Expr.mdata d e _   => return mkMData d (← loop below e)
    | Expr.proj n i e _  => return mkProj n i (← loop below e)
    | Expr.app _ _ _ =>
      let processApp (e : Expr) : M Expr :=
        e.withApp fun f args => do
          if f.isConstOf recFnName then
            let numFixed  := recArgInfo.fixedParams.size
            let recArgPos := recArgInfo.fixedParams.size + recArgInfo.pos
            if recArgPos >= args.size then
              throwError "insufficient number of parameters at recursive application {indentExpr e}"
            let recArg := args[recArgPos]
            -- For reflexive type, we may have nested recursive applications in recArg
            let recArg ← loop below recArg
            let f ← try toBelow below recArgInfo.indParams.size recArg catch  _ => throwError "failed to eliminate recursive application{indentExpr e}"
            -- Recall that the fixed parameters are not in the scope of the `brecOn`. So, we skip them.
            let argsNonFixed := args.extract numFixed args.size
            -- The function `f` does not explicitly take `recArg` and its indices as arguments. So, we skip them too.
            let mut fArgs := #[]
            for i in [:argsNonFixed.size] do
              if recArgInfo.pos != i && !recArgInfo.indicesPos.contains i then
                let arg := argsNonFixed[i]
                let arg ← replaceRecApps recFnName recArgInfo below arg
                fArgs := fArgs.push arg
            return mkAppN f fArgs
          else
            return mkAppN (← loop below f) (← args.mapM (loop below))
      let matcherApp? ← matchMatcherApp? e
      match matcherApp? with
      | some matcherApp =>
        if !recArgHasLooseBVarsAt recFnName recArgInfo.recArgPos e then
          processApp e
        else
          /- Here is an example we currently not handle
             ```
             def g (xs : List Nat) : Nat :=
             match xs with
             | [] => 0
             | y::ys =>
               match ys with
               | []       => 1
               | _::_::zs => g zs + 1
               | zs       => g ys + 2
             ```
             We are matching on `ys`, but still using `ys` in the third alternative.
             If we push the `below` argument over the dependent match it will be able to eliminate recursive call using `zs`.
             To make it work, users have to write the third alternative as `| zs => g zs + 2`
             If this is too annoying in practice, we may replace `ys` with the matching term, but
             this may generate weird error messages, when it doesn't work. -/
          trace[Elab.definition.structural] "below before matcherApp.addArg: {below} : {← inferType below}"
          let matcherApp ← mapError (matcherApp.addArg below) (fun msg => "failed to add `below` argument to 'matcher' application" ++ indentD msg)
          let altsNew ← (Array.zip matcherApp.alts matcherApp.altNumParams).mapM fun (alt, numParams) =>
            lambdaTelescope alt fun xs altBody => do
              trace[Elab.definition.structural] "altNumParams: {numParams}, xs: {xs}"
              unless xs.size >= numParams do
                throwError "unexpected matcher application alternative{indentExpr alt}\nat application{indentExpr e}"
              let belowForAlt := xs[numParams - 1]
              mkLambdaFVars xs (← loop belowForAlt altBody)
          pure { matcherApp with alts := altsNew }.toExpr
      | none => processApp e
    | e => ensureNoRecFn recFnName e
  loop below e

def mkBRecOn (recFnName : Name) (recArgInfo : RecArgInfo) (value : Expr) : M Expr := do
  let type  := (← inferType value).headBeta
  let major := recArgInfo.ys[recArgInfo.pos]
  let otherArgs := recArgInfo.ys.filter fun y => y != major && !recArgInfo.indIndices.contains y
  trace[Elab.definition.structural] "fixedParams: {recArgInfo.fixedParams}, otherArgs: {otherArgs}"
  let motive ← mkForallFVars otherArgs type
  let mut brecOnUniv ← getLevel motive
  trace[Elab.definition.structural] "brecOn univ: {brecOnUniv}"
  let useBInductionOn := recArgInfo.reflexive && brecOnUniv == levelZero
  if recArgInfo.reflexive && brecOnUniv != levelZero then
    brecOnUniv ← decLevel brecOnUniv
  let motive ← mkLambdaFVars (recArgInfo.indIndices.push major) motive
  trace[Elab.definition.structural] "brecOn motive: {motive}"
  let brecOn :=
    if useBInductionOn then
      Lean.mkConst (mkBInductionOnName recArgInfo.indName) recArgInfo.indLevels
    else
      Lean.mkConst (mkBRecOnName recArgInfo.indName) (brecOnUniv :: recArgInfo.indLevels)
  let brecOn := mkAppN brecOn recArgInfo.indParams
  let brecOn := mkApp brecOn motive
  let brecOn := mkAppN brecOn recArgInfo.indIndices
  let brecOn := mkApp brecOn major
  check brecOn
  let brecOnType ← inferType brecOn
  trace[Elab.definition.structural] "brecOn     {brecOn}"
  trace[Elab.definition.structural] "brecOnType {brecOnType}"
  forallBoundedTelescope brecOnType (some 1) fun F _ => do
    let F := F[0]
    let FType ← inferType F
    trace[Elab.definition.structural] "FType: {FType}"
    let FType ← instantiateForall FType recArgInfo.indIndices
    let FType ← instantiateForall FType #[major]
    forallBoundedTelescope FType (some 1) fun below _ => do
      let below := below[0]
      let valueNew     ← replaceRecApps recFnName recArgInfo below value
      let Farg         ← mkLambdaFVars (recArgInfo.indIndices ++ #[major, below] ++ otherArgs) valueNew
      let brecOn       := mkApp brecOn Farg
      return mkAppN brecOn otherArgs

end Lean.Elab.Structural


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_irrational_orbit {α : Type*} [linear_ordered_field α] (x : α) (hx : irrational x) :
  ∀ y : α, ∃ z : α, z ∈ ℤ → (x * z) - (x * ⌊x * z⌋) = y :=
begin
  assume y : α,
  have h1 : ∀ i j : ℤ, (i ≠ j) → (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋), from
    assume i j : ℤ, assume h2 : i ≠ j,
    have h3 : x * i ≠ x * j, from (hx i j).mpr h2,
    have h4 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)), from
      by {split, rintro ⟨ S_1, S_2 ⟩, split, exact S_1, exact S_2, rintro ⟨ S_3, S_4 ⟩, split, exact S_3, exact S_4},
    have h5 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)), from
      by {split, rintro ⟨ S_1, S_2 ⟩, split, exact S_1, exact S_2, rintro ⟨ S_3, S_4 ⟩, split, exact S_3, exact S_4},
    have h6 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)), from
      by {split, rintro ⟨ S_1, S_2 ⟩, split, exact S_1, exact S_2, rintro ⟨ S_3, S_4 ⟩, split, exact S_3, exact S_4},
    have h7 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)), from
      by {split, rintro ⟨ S_1, S_2 ⟩, split, exact S_1, exact S_2, rintro ⟨ S_3, S_4 ⟩, split, exact S_3, exact S_4},
    have h8 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)), from
      by {split, rintro ⟨ S_1, S_2 ⟩, split, exact S_1, exact S_2, rintro ⟨ S_3, S_4 ⟩, split, exact S_3, exact S_4},
    have h9 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)), from
      by {split, rintro ⟨ S_1, S_2 ⟩, split, exact S_1, exact S_2, rintro ⟨ S_3, S_4 ⟩, split, exact S_3, exact S_4},
    have h10 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)), from
      by {split, rintro ⟨ S_1, S_2 ⟩, split, exact S_1, exact S_2, rintro ⟨ S_3, S_4 ⟩, split, exact S_3, exact S_4},
    have h11 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)), from
      by {split, rintro ⟨ S_1, S_2 ⟩, split, exact S_1, exact S_2, rintro ⟨ S_3, S_4 ⟩, split, exact S_3, exact S_4},
    have h12 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)), from
      by {split, rintro ⟨ S_1, S_2 ⟩, split, exact S_1, exact S_2, rintro ⟨ S_3, S_4 ⟩, split, exact S_3, exact S_4},
    have h13 : (x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋) ↔
      ((x * i) - (x * ⌊x * i⌋) ≠ (x * j) - (x * ⌊x * j⌋)) ∧ ((x * ⌊x * i⌋) ≠ (x * ⌊x * j⌋)),
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) : α ∉ ℚ → ∀ ε > 0, ∃ n : ℤ, 0 ≤ n * α % 1 ∧ n * α % 1 < ε :=
begin
  assume h1 (ε : ℝ),
  assume h2 : ε > 0,
  have h3 : ∃ N : ℤ, ∀ n : ℤ, n ≥ N → 0 ≤ n * α % 1 ∧ n * α % 1 < ε, from
    begin
      let S : set ℝ := {n * α % 1 | n : ℤ},
      have h4 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from
        assume i j : ℤ,
        assume h5 : i ≠ j,
        assume h6 : (i * α % 1) = (j * α % 1),
        have h7 : ∃ x : ℤ, i * α = x + (i * α % 1), from exists_eq_mod_add_div i α,
        have h8 : ∃ x : ℤ, j * α = x + (j * α % 1), from exists_eq_mod_add_div j α,
        have h9 : ∃ x : ℤ, i * α = x + (j * α % 1), from exists_eq_add_of_eq_add h7 h6,
        have h10 : ∃ x : ℤ, j * α = x + (i * α % 1), from exists_eq_add_of_eq_add h8 h6,
        have h11 : i * α = j * α, from eq_add_of_eq_add_of_eq_add h9 h10,
        have h12 : α = (j - i)⁻¹ * (j * α - i * α), from by {rw h11, ring},
        have h13 : α ∈ ℚ, from by {rw h12, exact quotient_mul_mk_eq_mk_of_mem_denom h5},
        show false, from by {exact absurd h13 h1},

      have h14 : ∀ i j : ℤ, i ≠ j → i * α % 1 ≠ j * α % 1, from assume i j : ℤ, assume h15 : i ≠ j, by {rw ← mod_eq_of_lt (lt_of_le_of_lt (le_of_lt h2) (lt_add_one 1)), exact h4 i j h15},

      have h16 : S.nonempty, from by {apply set.nonempty.intro,exact 0,},

      have h17 : S.infinite, from by {apply infinite_of_injective_of_nonempty h14 h16,},

      have h18 : S.bounded_above, from by {apply set.bounded_above_Icc, exact 0, exact 1,},

      have h19 : S.bounded_below, from by {apply set.bounded_below_Icc, exact 0, exact 1,},

      have h20 : S.bounded, from by {apply set.bounded_of_bounded_above_of_bounded_below h18 h19,},

      have h21 : S.nonempty, from by {apply set.nonempty.intro, exact 0,},

      have h22 : ∃ x : ℝ, x ∈ S ∧ x ≤ ε, from by {apply set.exists_mem_of_ne_empty h21,},

      have h23 : ∃ x : ℝ, x ∈ S ∧ x ≤ ε ∧ ∀ y : ℝ, y ∈ S → y ≤ x, from by {apply exists_least h22,},

      cases h23 with x h24,
      cases h24 with h25 h26,
      cases h26 with h27 h28,
      have h29 : ∃ N : ℤ, x < N + 1, from by {apply exists_lt_of_lt_of_le h27 (le_add_one 1),},

      cases h29 with N h30,
      use N,
      have h31 : ∀ n : ℤ, n ≥ N → 0 ≤ n * α % 1 ∧ n * α % 1 < ε, from
        assume n : ℤ,
        assume h31 : n ≥ N,
        have h32 : n * α % 1 ∈ S, from by {apply set.mem_of_mem_Icc, exact 0, exact 1,},
        have h33 : n * α % 1 ≤ x, from h28 n h32,
        have h34 : n * α % 1 < ε, from lt_of_lt_of_le h30 h31,
        split, exact le_of_lt h34, exact h34,
      exact h31,
    end,

  cases h3 with N h4,
  use N,
  exact h4 N (le_refl N),
end

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : irrational α) :
  ∀ ε > 0, ∃ x ∈ ℤ, |x - α * x| < ε :=
begin
  assume ε hε,
  have h1 : ∀ (i j : ℤ), i ≠ j → (i : ℝ) * α - i ≠ (j : ℝ) * α - j, from by {
    assume (i j : ℤ) (hij : i ≠ j),
    assume hij2 : (i : ℝ) * α - i = (j : ℝ) * α - j,
    have h2 : (i : ℝ) * α - i = (j : ℝ) * α - j, from by {
      rw ← hij2,
      ring,
    },
    have h3 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw h2,
      ring,
    },
    have h4 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw ← h3,
      ring,
    },
    have h5 : (i : ℝ) = (j : ℝ), from by {
      rw ← h4,
      ring,
    },
    have h6 : (i : ℝ) = (j : ℝ), from by {
      rw ← h5,
      ring,
    },
    have h7 : (i : ℝ) = (j : ℝ), from by {
      rw ← h6,
      ring,
    },
    have h8 : (i : ℝ) = (j : ℝ), from by {
      rw ← h7,
      ring,
    },
    have h9 : (i : ℝ) = (j : ℝ), from by {
      rw ← h8,
      ring,
    },
    have h10 : (i : ℝ) = (j : ℝ), from by {
      rw ← h9,
      ring,
    },
    have h11 : (i : ℝ) = (j : ℝ), from by {
      rw ← h10,
      ring,
    },
    have h12 : (i : ℝ) = (j : ℝ), from by {
      rw ← h11,
      ring,
    },
    have h13 : (i : ℝ) = (j : ℝ), from by {
      rw ← h12,
      ring,
    },
    have h14 : (i : ℝ) = (j : ℝ), from by {
      rw ← h13,
      ring,
    },
    have h15 : (i : ℝ) = (j : ℝ), from by {
      rw ← h14,
      ring,
    },
    have h16 : (i : ℝ) = (j : ℝ), from by {
      rw ← h15,
      ring,
    },
    have h17 : (i : ℝ) = (j : ℝ), from by {
      rw ← h16,
      ring,
    },
    have h18 : (i : ℝ) = (j : ℝ), from by {
      rw ← h17,
      ring,
    },
    have h19 : (i : ℝ) = (j : ℝ), from by {
      rw ← h18,
      ring,
    },
    have h20 : (i : ℝ) = (j : ℝ), from by {
      rw ← h19,
      ring,
    },
    have h21 : (i : ℝ) = (j : ℝ), from by {
      rw ← h20,
      ring,
    },
    have h22 : (i : ℝ) = (j : ℝ), from by {
      rw ← h21,
      ring,
    },
    have h23 : (i : ℝ) = (j : ℝ), from by {
      rw ← h22,
      ring,
    },
    have h24 : (i : ℝ) = (j : ℝ), from by {
      rw ← h23,
      ring,
    },
    have h25 : (i : ℝ) = (j : ℝ), from by {
      rw ← h24,
      ring,
    },
    have h26 : (i : ℝ) = (j : ℝ), from by {
      rw ← h25,
      ring,
    },
    have h27 : (i : ℝ) = (j : ℝ), from by {
      rw ← h26,
      ring,
    },
    have h28 : (i : ℝ) = (j : ℝ), from by {
      rw ← h27,
      ring,
    },
    have h29 : (i : ℝ) = (j : ℝ), from by {
      rw ← h28,
      ring,
    },
    have h30 : (i : ℝ) = (j : ℝ), from by {
      rw ← h29,
      ring,
    },
    have h31 : (i : ℝ) = (j : ℝ), from by {
      rw ← h30,
      ring,
    },
    have h32 : (i : ℝ) = (j : ℝ), from by {
      rw ← h31,
      ring,
    },
    have h33 : (i : ℝ) = (j : ℝ), from by {
      rw ← h32,
      ring,
    },
    have h34 : (i : ℝ) = (j : ℝ), from by {
      rw ← h33,
      ring,
    },
    have h35 : (i : ℝ) = (j : ℝ), from by {
      rw ← h34,
      ring,
    },
    have h36 : (i : ℝ) = (j : ℝ), from by {
      rw ← h35,
      ring,
    },
    have h37 : (i : ℝ) = (j : ℝ), from by {
      rw ← h36,
      ring,
    },
    have h38 : (i : ℝ) = (j : ℝ), from by {
      rw ← h37,
      ring,
    },
    have h39 : (i : ℝ) = (j : ℝ), from by {
      rw ← h38,
      ring,
    },
    have h40 : (i : ℝ) = (j : ℝ), from by {
      rw ← h39,
      ring,
    },
    have h41 : (i : ℝ) = (j : ℝ), from by {
      rw ← h40,
      ring,
    },
    have h42 : (i : ℝ) = (j : ℝ), from by {
      rw ← h41,
      ring,
    },
    have h43 : (i : ℝ) = (j : ℝ), from by {
      rw ← h42,
      ring,
    },
    have h44 : (i : ℝ) = (j : ℝ), from by {
      rw ← h43,
      ring,
    },
    have h45 : (i : ℝ) = (j : ℝ), from by {
      rw ← h44,
      ring,
    },
    have h46 : (i : ℝ) = (j : ℝ), from by {
      rw ← h45,
      ring,
    },
    have h47 : (i : ℝ) = (j : ℝ), from
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) : irrational α → ∀ ε > 0, ∃ n : ℤ, 0 ≤ n * α % 1 ∧ n * α % 1 < ε :=
begin
  assume h1 (ε : ℝ),
  assume h2 : ε > 0,
  have h3 : ∀ (i : ℤ), ∃ (j : ℤ), j * α % 1 < ε, from by {
    assume i,
    have h4 : ∃ (j : ℤ), j * α % 1 < ε, from by {
      have h5 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0, from by {
        have h6 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0, from by {
          have h7 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε, from by {
            have h8 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0, from by {
              have h9 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε, from by {
                have h10 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε, from by {
                  have h11 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε, from by {
                    have h12 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε, from by {
                      have h13 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε, from by {
                        have h14 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε ∧ j < -6/ε, from by {
                          have h15 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε ∧ j < -6/ε ∧ j < -7/ε, from by {
                            have h16 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε ∧ j < -6/ε ∧ j < -7/ε ∧ j < -8/ε, from by {
                              have h17 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε ∧ j < -6/ε ∧ j < -7/ε ∧ j < -8/ε ∧ j < -9/ε, from by {
                                have h18 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε ∧ j < -6/ε ∧ j < -7/ε ∧ j < -8/ε ∧ j < -9/ε ∧ j < -10/ε, from by {
                                  have h19 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε ∧ j < -6/ε ∧ j < -7/ε ∧ j < -8/ε ∧ j < -9/ε ∧ j < -10/ε ∧ j < -11/ε, from by {
                                    have h20 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε ∧ j < -6/ε ∧ j < -7/ε ∧ j < -8/ε ∧ j < -9/ε ∧ j < -10/ε ∧ j < -11/ε ∧ j < -12/ε, from by {
                                      have h21 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε ∧ j < -6/ε ∧ j < -7/ε ∧ j < -8/ε ∧ j < -9/ε ∧ j < -10/ε ∧ j < -11/ε ∧ j < -12/ε ∧ j < -13/ε, from by {
                                        have h22 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j < -5/ε ∧ j < -6/ε ∧ j < -7/ε ∧ j < -8/ε ∧ j < -9/ε ∧ j < -10/ε ∧ j < -11/ε ∧ j < -12/ε ∧ j < -13/ε ∧ j < -14/ε, from by {
                                          have h23 : ∃ (j : ℤ), j * α % 1 < ε ∧ j * α % 1 ≥ 0 ∧ j > 0 ∧ j < 1/ε ∧ j < 0 ∧ j < -1/ε ∧ j < -2/ε ∧ j < -3/ε ∧ j < -4/ε ∧ j <
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ (α ∈ ℚ)) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y :=
begin
  assume y h,
  have h1 : ∀ i j : ℤ, i ≠ j → ((i : ℝ) * α % 1) ≠ ((j : ℝ) * α % 1), from
    assume i j h2, assume h3,
    have h4 : (i : ℝ) * α % 1 = (j : ℝ) * α % 1, from eq.trans h3 (set.mem_range_self j),
    have h5 : (i : ℝ) * α = (j : ℝ) * α, from congr_arg (λ x, x % 1) h4,
    have h6 : (i : ℝ) = (j : ℝ), from mul_right_cancel α h5,
    have h7 : i = j, from int.eq_of_mul_eq_mul_right hα h6,
    show false, from h2 h7,
  have h8 : set.range (λ (n : ℤ), (n : ℝ) * α % 1) ≠ ∅, from
    assume h9,
    have h10 : ∀ i : ℤ, (i : ℝ) * α % 1 = 0, from by {intro i, apply set.mem_range_self i,},
    have h11 : ∀ i : ℤ, (i : ℝ) * α = 0, from by {intro i, rw h10 i, ring,},
    have h12 : ∀ i : ℤ, i = 0, from by {intro i, rw ← int.cast_zero, rw ← int.cast_eq_zero, rw int.cast_mul, rw h11 i, ring,},
    have h13 : ∀ i : ℤ, i ≠ 0, from by {intro i, rw h12 i, exact dec_trivial,},
    have h14 : ∀ i : ℤ, i = i, from dec_trivial,
    have h15 : ∀ i : ℤ, i = 0 ∧ i ≠ 0, from by {intro i, split, exact h12 i, exact h13 i,},
    have h16 : ∀ i : ℤ, false, from by {intro i, cases h15 i, exact h15.left i, exact h15.right i,},
    show false, from h16 0,
  have h17 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
    assume y h18,
    have h19 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
      assume y h20,
      have h21 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
        assume y h22,
        have h23 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
          assume y h24,
          have h25 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
            assume y h26,
            have h27 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
              assume y h28,
              have h29 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                assume y h30,
                have h31 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                  assume y h32,
                  have h33 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                    assume y h34,
                    have h35 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                      assume y h36,
                      have h37 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                        assume y h38,
                        have h39 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                          assume y h40,
                          have h41 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                            assume y h42,
                            have h43 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                              assume y h44,
                              have h45 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                                assume y h46,
                                have h47 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                                  assume y h48,
                                  have h49 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                                    assume y h50,
                                    have h51 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                                      assume y h52,
                                      have h53 : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ∈ set.range (λ n : ℤ, (n : ℝ) * α % 1) ∧ x ≠ y, from
                                        assume y h54,
                                        have h55 : ∀ y ∈ Icc 0 1, ∃ x ∈ I
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬(∃ (q : ℚ), α = q)) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, ∃ n : ℤ, x = n • α ∧ |y - x| < 1 :=
begin
  assume y h,
  have h1 : ∀ (i j : ℤ), i ≠ j → (i • α) - (floor (i • α)) ≠ (j • α) - (floor (j • α)), from
  begin
    assume (i j : ℤ) (h2 : i ≠ j),
    have h3 : (i • α) - (floor (i • α)) = (j • α) - (floor (j • α)) → α = (floor (i • α) - floor (j • α)) / (i - j), from
    begin
      assume h3,
      have h4 : α = (floor (i • α) - floor (j • α)) / (i - j), from by {rw h3, rw div_eq_iff_mul_eq, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw
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`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by
  {
    intro x0,
    have h6 : |x0 - l| < ε ↔ ((x0 - l) < ε) ∧ ((l - x0) < ε),
    from abs_sub_lt_iff, rw h6,
    split,
    rintro ⟨ S_1, S_2 ⟩,
    split; linarith,
    rintro ⟨ S_3, S_4 ⟩,
    split; linarith,
    },

  assume (h7 : ε > 0),
  cases h2 ε h7 with N1 h8,
  cases h3 ε h7 with N2 h9,

  let N := max N1 N2,
  use N,

  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by {
    assume n h,
    split,
    exact lt_of_le_of_lt (le_max_left N1 N2) h,
    exact lt_of_le_of_lt (le_max_right N1 N2) h,
  },

  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by {
    intros n h12,
    split,
    {

      have h13 := (h8 n (h10 n h12).left), rw h5 (y n) at h13,
      split,
      exact h13.left,
      exact (h4 n).left,
    },
    {
      have h14 := (h9 n (h10 n h12).right),rw h5 (z n) at h14,
      split,
      exact (h4 n).right,
      exact h14.right,
    },

  },

  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by {
    intros n1 h16, cases (h11 n1 h16);
    split; linarith,
  },

  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by {
    intros n h17,
    cases h5 (x n) with h18 h19,
    apply h19, exact h15 n h17,
  },
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.algebra.continuous_functions
import Mathlib.linear_algebra.affine_space.affine_map
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Topological properties of affine spaces and maps

For now, this contains only a few facts regarding the continuity of affine maps in the special
case when the point space and vector space are the same.
-/

namespace affine_map

/-
TODO: Deal with the case where the point spaces are different from the vector spaces.
-/

/-- An affine map is continuous iff its underlying linear map is continuous. -/
theorem continuous_iff {R : Type u_1} {E : Type u_2} {F : Type u_3} [ring R] [add_comm_group E]
    [semimodule R E] [topological_space E] [add_comm_group F] [semimodule R F] [topological_space F]
    [topological_add_group F] {f : affine_map R E F} : continuous ⇑f ↔ continuous ⇑(linear f) :=
  sorry

/-- The line map is continuous. -/
theorem line_map_continuous {R : Type u_1} {F : Type u_3} [ring R] [add_comm_group F]
    [semimodule R F] [topological_space F] [topological_add_group F] [topological_space R]
    [topological_semimodule R F] {p : F} {v : F} : continuous ⇑(line_map p v) :=
  iff.mpr continuous_iff
    (continuous.add (continuous.smul continuous_id continuous_const) continuous_const)

end Mathlib


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Std.Classes.LawfulMonad

import Algdata.Data.Array.Lemmas

namespace Array

universe u v

variable {m : Type u → Type v} [Monad m] {α : Type u}

@[simp]
theorem modifyM_nil (n : Nat) (f : α → m α) : #[].modifyM n f = pure #[] := by
  rfl

@[simp]
theorem modifyM_head (a : α) (as : List α) (f : α → m α) : modifyM {data := a::as} 0 f = (f a >>= fun a' => pure {data := a' :: as }) := by
  dsimp [modifyM]
  rw [dif_pos (Nat.zero_lt_succ _)]
  conv =>
    lhs; lhs; change f a

-- modifyM with an out-of-range index
theorem modifyM_oor (x : Array α) (n : Nat) (f : α → m α) : ¬(n < x.size) → x.modifyM n f = pure x := by
  intro h
  rw [modifyM, dif_neg h]

theorem modifyM_tail [LawfulMonad m] {α : Type _} (a : α) (as : List α) (n : Nat) (f : α → m α) : Array.modifyM {data := a::as} n.succ f = #[a].append <$> (Array.modifyM {data := as} n f) := by
  by_cases n < as.length
  case pos hpos =>
    dsimp [modifyM, modifyM]
    have : n.succ < size {data := as} + 1 :=
      Nat.succ_lt_succ hpos
    rw [dif_pos this, dif_pos hpos]
    rw [bind_pure_comp, bind_pure_comp, ←comp_map]
    apply map_congr
    intro a
    rw [set_cons_succ']
    rfl
  case neg hneg =>
    rw [modifyM_oor {data := as} n f hneg]
    have : ¬(n.succ < size {data := a::as}) := hneg ∘ Nat.lt_of_succ_lt_succ
    rw [modifyM_oor {data := a::as} n.succ f this]
    simp
    apply congrArg
    apply Array.eq
    conv =>
      rhs; rw [append_data]; change [a] ++ as; change a::as

@[simp]
theorem modify_nil (n : Nat) (f : α → α) : Array.modify #[] n f = #[] := by
  rw [modify, Id.run, modifyM_nil]
  rfl

@[simp]
theorem modify_head (a : α) (as : List α) (f : α → α) : Array.modify {data := a::as} 0 f = {data := f a :: as} := by
  rw [modify, Id.run, modifyM_head]
  rfl

theorem modify_oor (x : Array α) (n : Nat) (f : α → α) (h : ¬(n < x.size)) : x.modify n f = x := by
  rw [modify, Id.run, modifyM_oor (m:=Id) x n f h]
  rfl

@[simp]
theorem modify_tail (a : α) (as : List α) {k : Nat} {f : α → α} : Array.modify {data := a::as} k.succ f = #[a].append (modify {data := as} k f) := by
  rw [modify, Id.run, modify, Id.run]
  exact modifyM_tail (m:=Id) a as k f

theorem size_modifyM [LawfulMonad m] {α : Type _} : ∀ (x : Array α) (n : Nat) (f : α → m α), SatisfiesM (fun y => y.size = x.size) (x.modifyM n f)
| mk as => by
  induction as with
  | nil =>
    intros n f
    exists pure (f:=m) (Subtype.mk (p:=fun y => y.size = (mk (α:=α) []).size) (mk (α:=α) []) rfl)
    have : mk (α:=α) [] = #[] := rfl
    rw [this, modifyM_nil]; clear this
    rw [map_pure]
  | cons a as hi =>
    intros n f
    cases n with
    | zero =>
      simp
      exists f a >>= fun a' => pure (Subtype.mk (p:=fun y => y.size = as.length.succ) (mk (a'::as)) rfl)
      rw [bind_pure_comp, bind_pure_comp]
      rw [←comp_map]
      rfl
    | succ n =>
      rw [modifyM_tail]
      apply SatisfiesM.map (p:=λ y => y.size = as.length)
      . cases hi n f with | intro w hw =>
        exact Exists.intro w hw
      . intros y hy;
        conv =>
          lhs; change size (#[a] ++ y);
          rw [size_eq_length_of_data, append_data, List.length_append]
          change 1 + y.size; rw [hy]
        exact Nat.add_comm 1 _

@[simp]
theorem size_modify : ∀ (x : Array α) (n : Nat) (f : α → α), (x.modify n f).size = x.size := by
  intro x n f
  cases size_modifyM (m:=Id) x n f with | intro w hw =>
  dsimp at hw
  conv at hw => rhs; change modify x n f
  rw [←hw]
  exact w.property

end Array


import data.cpi.prefix_expr data.cpi.affinity
import tactic.custom_wf tactic.known_induct

instance vector.has_empty {α : Type} : has_emptyc (vector α 0) := { emptyc := vector.nil }

namespace cpi

namespace species

/-- As the doc-strinct of 'whole' says, species and their choices are bundled
    into one type. We index on this "kind", which says whether this constructor
    represents a species, or is part of a guarded choice. -/
@[nolint has_inhabited_instance]
inductive kind
| species
| choices

/-- The set of species and choices.

    Species are composed of:
      - The inactive species
      - Invocation of a species definition
      - Guarded choice
      - Parallel composition
      - Local name declaration/restriction

    Choices are just a series of prefixes and a species to be evaluated after
    that prefix.

    While this could (and probably should) be defined as a mutually recursive
    datatype (or even a nested one, instead of a home-grown list), Lean's
    handling of recursive types is a little lacklustre: one cannot use the
    induction tactic, Lean often fails to show termination on its own, etc...

    In order to avoid these problems, we represent mutually-recursive type the
    same way that Lean does (as a single type indexed by what group it belongs
    to), but avoid the indirection that such a definition would introduce. -/
@[derive decidable_eq, nolint has_inhabited_instance]
inductive whole (ℍ : Type) (ω : context) : kind → context → Type
/- Species -/
| nil {} {Γ} : whole kind.species Γ
| apply {} {Γ} {n} : reference n ω → vector (name Γ) n → whole kind.species Γ
| choice {Γ} : whole kind.choices Γ → whole kind.species Γ
| parallel {Γ} : whole kind.species Γ → whole kind.species Γ → whole kind.species Γ
| restriction {Γ} (M : affinity ℍ) :
    whole kind.species (context.extend M.arity Γ) → whole kind.species Γ
/- Elements in the sum -/
| empty {} {Γ} : whole kind.choices Γ
| cons {Γ} {f} (π : prefix_expr ℍ Γ f) :
    whole kind.species (f.apply Γ) → whole kind.choices Γ → whole kind.choices Γ

/-- An alias for species within the `whole' datatype. -/
@[reducible, nolint dup_namespace]
def species (ℍ : Type) (ω : context) := @whole ℍ ω kind.species

/-- An alias for choices within the `whole' datatype. -/
@[reducible]
def choices (ℍ : Type) (ω : context) := @whole ℍ ω kind.choices

variables {ℍ : Type} {ω : context}

export whole (nil apply choice parallel restriction)
open whole

reserve infixr ` |ₛ ` :50
infixr ` |ₛ ` := parallel

notation `ν(` M `) ` A := restriction M A

reserve prefix `Σ#`: 40
prefix `Σ# ` := choice

/-- Construct a singleton choice from a prefix and species. -/
def choices.mk_one' {Γ f} (π : prefix_expr ℍ Γ f) (A : species ℍ ω (f.apply Γ))
  := whole.cons π A whole.empty

/-- Construct a singleton sum from a prefix and species. -/
def choices.mk_one {Γ f} (π : prefix_expr ℍ Γ f) (A : species ℍ ω (f.apply Γ))
  := Σ# (choices.mk_one' π A)

reserve infixr ` ⬝' `:75

infixr ` ⬝ ` := choices.mk_one
infixr ` ⬝' ` := choices.mk_one'

/-- Convert a species to a string. Can use `repr` normally. -/
protected def to_string [has_repr ℍ] : ∀ {k Γ}, whole ℍ ω k Γ → string
| k ._ nil := "0"
| k ._ (apply D as) := repr D ++ "(" ++ repr as.val ++ ")"
| k ._ (Σ# (whole.cons π A' whole.empty)) := to_string (whole.cons π A' whole.empty)
| k ._ (Σ# As) := "Σ#[" ++ to_string As ++ "]"
| k ._ (A' |ₛ B') := "(" ++ to_string A' ++ " | " ++ to_string B' ++ ")"
| k ._ (ν(M) a) := "(ν ?)(" ++ to_string a ++ ")"
| k ._ whole.empty := "∅"
| k ._ (whole.cons π A' whole.empty) := repr π ++ "." ++ to_string A'
| k ._ (whole.cons π A' (whole.cons π' B' As)) := repr π ++ "." ++ to_string A' ++ " + " ++ to_string (whole.cons π' B' As)

instance [has_repr ℍ] {Γ} : has_repr (species ℍ ω Γ) := ⟨ species.to_string ⟩

section free
  /-- Determine if any variable with a given level occurs within this species. -/
  def free_in {Γ} {k} (l : level Γ) (A : whole ℍ ω k Γ) : Prop := begin
    induction A,
    case nil { from false },
    case apply : Γ n D as { from ∃ a ∈ as.val, l ∈ a },
    case choice : Γ As ih { from ih l },
    case parallel : Γ A B ih_a ih_b { from ih_a l ∨ ih_b l },
    case restriction : Γ M A ih { from ih (level.extend l) },
    case whole.empty : Γ { from false },
    case whole.cons : Γ f π A As ih_a ih_as {
      from l ∈ π ∨ ih_a (prefix_expr.raise π l) ∨ ih_as l
    }
  end

  instance {Γ} {k} : has_mem (level Γ) (whole ℍ ω k Γ) := ⟨ free_in ⟩

  private def free_in_decide {Γ} {k} (l : level Γ) (A : whole ℍ ω k Γ) : decidable (free_in l A) := begin
    induction A,

    case nil { from decidable.false },
    case apply : { unfold free_in, apply_instance },
    case choice : Γ As ih { from ih l },
    case parallel : Γ A B ih_a ih_b { from @or.decidable _ _ (ih_a l) (ih_b l) },
    case restriction : Γ M A ih { from ih (level.extend l) },
    case whole.empty { from decidable.false },
    case whole.cons : Γ f π A As ih_a ih_as {
      from @or.decidable (l ∈ π) _ _
        (@or.decidable _ _ (ih_a (prefix_expr.raise π l)) (ih_as l))
    }
  end

  instance free_in.decidable {Γ} {k} {l} {A: whole ℍ ω k Γ} : decidable (free_in l A)
    := free_in_decide l A
end free

section rename
  /-- Apply a renaming function to a species, with a witness of presence. -/
  def rename_with : ∀ {Γ Δ} {k} (A : whole ℍ ω k Γ)
    (ρ : Π (a : name Γ), name.to_level a ∈ A → name Δ), whole ℍ ω k Δ
  | Γ Δ ._ nil ρ := nil
  | Γ Δ ._ (@apply _ _ _ n D as) ρ :=
    let as' := list.map_witness as.val (λ x mem, ρ x ⟨ x, mem, name.to_level_at x ⟩) in
    let eq : list.length as' = n := by { rw (list.map_witness_length as.val _), from as.property } in
    apply D ⟨ as', eq ⟩
  | Γ Δ ._ (A |ₛ B) ρ :=
    rename_with A (λ a free, ρ a (or.inl free)) |ₛ
    rename_with B (λ a free, ρ a (or.inr free))
  | Γ Δ ._ (ν(M)A) ρ :=
      let ρ' := λ a free, ρ a (free) in
      ν(M) rename_with A (name.ext_with (λ l, l ∈ A) ρ')
  | Γ Δ ._ (Σ# As) ρ:=
    let ρ' := (λ a free, ρ a (free)) in
    Σ# rename_with As ρ'
  | Γ Δ ._ empty ρ := empty
  | Γ Δ ._ (cons π A As) ρ :=
    cons
      (prefix_expr.rename_with π (λ a free, ρ a (or.inl free)))
      (rename_with A
        (prefix_expr.ext_with π (λ l, l ∈ A) (λ a free, ρ a (or.inr (or.inl free)))))
      (rename_with As (λ a free, ρ a (or.inr (or.inr free))))
  using_well_founded {
    rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ s, sizeof s.snd.snd.snd.fst)⟩],
    dec_tac := tactic.fst_dec_tac,
  }

  /-- A simpler version of rename_with, which does not require a witness. -/
  def rename {Γ Δ} {k} (ρ : name Γ → name Δ) (A : whole ℍ ω k Γ) : whole ℍ ω k Δ
    := rename_with A (λ a _, ρ a)

  /-- Renaming with the identity function does nothing. -/
  lemma rename_with_id : ∀ {Γ} {k} (A : whole ℍ ω k Γ), rename_with A (λ x _, x) = A
  | Γ ._ nil := by unfold rename_with
  | Γ ._ (apply D as) := by simp [rename_with]
  | Γ ._ (A |ₛ B) :=
    let a : rename_with A _ = A := rename_with_id A in
    let b : rename_with B _ = B := rename_with_id B in
    by { unfold rename_with, rw [a, b] }
  | Γ ._ ν(M)A :=
    let a : rename_with A _ = A := rename_with_id A in
    begin
        simp only [rename_with],
        have h := name.ext_with_id (λ l, l ∈ A),
        have g
          : (λ (x : name Γ) (free : (λ (l : level (context.extend (M.arity) Γ)), l ∈ A) (level.extend (name.to_level x))), x)
          = (λ (a : name Γ) (free : name.to_level a ∈ ν(M) A), a) := rfl,
        rw g at h, rw h,
        simp [a]
    end
  | Γ ._ (Σ# As) := by { simp only [rename_with], from rename_with_id As }
  | Γ ._ empty := by unfold rename_with
  | Γ ._ (cons π A As) :=
    let π' : prefix_expr.rename_with π _ = π := prefix_expr.rename_with_id π in
    let a : rename_with A _ = A := rename_with_id A in
    let as : rename_with As _ = As := rename_with_id As in
    begin
      simp [rename_with],
      rw prefix_expr.ext_with_id,
      simp [π', a, as]
    end

  /-- Renaming with the identity function is the identity. -/
  lemma rename_id {Γ} {k} (A : whole ℍ ω k Γ): rename id A = A := rename_with_id A

  /-- Renaming twice is the same as renaming with a composed function. -/
  lemma rename_with_compose :
    ∀ {Γ Δ η} {k}
      (A : whole ℍ ω k Γ)
      (ρ : (Π (a : name Γ), name.to_level a ∈ A → name Δ))
      (σ : name Δ → name η)
    , rename σ (rename_with A ρ) = rename_with A (λ x f, σ (ρ x f))
  | Γ Δ η ._ nil ρ σ := by unfold rename rename_with
  | Γ Δ η ._ (apply D as) ρ σ := by simp [rename, rename_with, list.map_witness_to_map]
  | Γ Δ η ._ (A |ₛ B) ρ σ :=
    let a := rename_with_compose A (λ a free, ρ a (or.inl free)) σ in
    let b := rename_with_compose B (λ a free, ρ a (or.inr free)) σ in
    by { simp [rename, rename_with], from and.intro a b }
  | Γ Δ η ._ (ν(M) A) ρ σ := begin
      simp [rename, rename_with, name.ext_with],

      suffices
        : rename (name.ext σ) (rename_with A (name.ext_with (λ l, l ∈ A) ρ))
        = rename_with A (name.ext_with (λ l, l ∈ A) (λ a free, σ (ρ a free))),
        unfold rename name.ext at this,
        rw ← name.ext_with_discard (λ l, l ∈ rename_with A (name.ext_with (λ l, l ∈ A) ρ)) σ at this,
        from this,

      have h := rename_with_compose A
            (name.ext_with (λ l, l ∈ A) (λ a free, ρ a (free)))
            (name.ext σ),

      from name.ext_with_comp (λ l, l ∈ A) ρ σ ▸ h,
    end
  | Γ Δ η ._ (Σ# As) ρ σ := begin
      simp [rename, rename_with],
      from rename_with_compose As _ σ
    end
  | Γ Δ η ._ empty ρ σ := by unfold rename rename_with
  | Γ Δ η ._ (cons π A As) ρ σ := begin
      simp [rename, rename_with, prefix_expr.ext_with],

      have π' := prefix_expr.rename_with_compose π (λ a f, ρ a (or.inl f)) σ,
      have A' := rename_with_compose A
        (prefix_expr.ext_with π (λ l, l ∈ A) (λ a f, ρ a (or.inr (or.inl f))))
        (prefix_expr.ext π σ),
      have As' := rename_with_compose As (λ a f, ρ a (or.inr (or.inr f))) σ,

      -- Massage A and ⊢ into shape
      rw prefix_expr.ext_with_comp π (λ l, l ∈ A) at A',
      unfold rename prefix_expr.ext at A',

      rw prefix_expr.ext_with_discard
        (prefix_expr.rename_with π (λ a free, ρ a _))
        (λ l, l ∈ rename_with A (prefix_expr.ext_with π (λ l, l ∈ A) (λ a free, ρ a _)))
        σ,
      rw prefix_expr.rename_with_ext_with π,

      from ⟨ π', A', As' ⟩,
    end

  /-- Renaming twice is the same as renaming with a composed function. -/
  lemma rename_compose {Γ Δ η k} (ρ : name Γ → name Δ) (σ : name Δ → name η) (A : whole ℍ ω k Γ)
    : rename σ (rename ρ A) = rename (σ ∘ ρ) A
    := rename_with_compose A (λ x _, ρ x) σ

  lemma rename_ext {Γ Δ k} {ρ : name Γ → name Δ} {n : ℕ} (A : whole ℍ ω k Γ)
    : rename name.extend (rename ρ A)
    = rename (name.ext ρ) (rename (@name.extend _ n) A)
    := by rw [rename_compose, ← name.ext_extend, rename_compose]
end rename

/- Various equational lemmas for rewrite.

   This just simplifies the work needed to do when using simple rewriting
   functions (such as in equivalency or pseduo-application).-/
section rename_equations
  variables {Γ Δ : context} {ρ : name Γ → name Δ}

  @[simp]
  lemma rename.nil : rename ρ (@nil ℍ ω Γ) = nil := by unfold rename rename_with

  @[simp]
  lemma rename.invoke {n} (D : reference n ω) (as : vector (name Γ) n)
    : rename ρ (apply D as) = @apply ℍ _ _ _ D (vector.map ρ as)
    := begin
      cases as with as p,
      unfold rename rename_with vector.map, simp,
      from list.map_witness_to_map _ as,
    end

  @[simp]
  lemma rename.parallel (A B : species ℍ ω Γ)
    : rename ρ (A |ₛ B) = (rename ρ A |ₛ rename ρ B)
    := by unfold rename rename_with

  @[simp]
  lemma rename.restriction (M : affinity ℍ) (A : species ℍ ω (context.extend M.arity Γ))
    : rename ρ (ν(M)A ) = ν(M) (rename (name.ext ρ) A)
    := begin
      unfold rename rename_with name.ext,
      rw ← name.ext_with_discard (λ l, l ∈ A) ρ,
      from rfl
    end

  @[simp]
  lemma rename.choice (As : choices ℍ ω Γ): rename ρ (Σ# As) = Σ# (rename ρ As) := begin
    unfold rename rename_with,
    have : (λ (a : name Γ) (free : name.to_level a ∈ Σ# As), ρ a)
         = (λ (a : name Γ) (free : name.to_level a ∈ As), ρ a)
        := (funext $ λ a, funext $ λ free, rfl),
    rw this,
  end

  @[simp]
  lemma rename.empty : rename ρ (@whole.empty ℍ ω Γ) = empty := by unfold rename rename_with

  @[simp]
  lemma rename.cons {f} (π : prefix_expr ℍ Γ f) (A : species ℍ ω (f.apply Γ)) (As : choices ℍ ω Γ)
    : rename ρ (cons π A As)
    = cons (prefix_expr.rename ρ π) (rename (prefix_expr.ext π ρ) A) (rename ρ As)
    := begin
      unfold rename rename_with prefix_expr.rename prefix_expr.ext,
      rw prefix_expr.ext_with_discard π (λ l, _) ρ
    end

  lemma rename.inj :
    ∀ {Γ Δ k} {ρ : name Γ → name Δ}
    , function.injective ρ → function.injective (@rename ℍ ω Γ Δ k ρ)
  | Γ Δ _ ρ inj nil B eq := begin
      cases B;
      simp only [rename.nil, rename.invoke, rename.parallel, rename.choice, rename.restriction] at eq;
      contradiction,
    end
  | Γ Δ _ ρ inj (apply D as) B eq := begin
      cases B;
      simp only [rename.nil, rename.invoke, rename.parallel, rename.choice, rename.restriction] at eq;
      try { contradiction },
      case apply : n D' as' {
        rcases eq with ⟨ ⟨ _ ⟩, ⟨ eqD ⟩, eqAs ⟩,

        -- Show the vector is equal
        rcases as with ⟨ as, asL ⟩, rcases as' with ⟨ as', asL' ⟩,
        have eqAs := eq_of_heq eqAs,
        simp only [vector.map, subtype.mk_eq_mk] at eqAs,
        cases (list.injective_map_iff.mpr inj eqAs),

        from rfl,
      },
    end
  | Γ Δ _ ρ inj (A |ₛ B) C eq := begin
      cases C;
      simp only [rename.nil, rename.invoke, rename.parallel, rename.choice, rename.restriction] at eq;
      try { contradiction },

      case whole.parallel {
        cases rename.inj inj eq.left,
        cases rename.inj inj eq.right,
        from rfl,
      },
    end
  | Γ Δ _ ρ inj (Σ# As) B eq := begin
      cases B;
      simp only [rename.nil, rename.invoke, rename.parallel, rename.choice, rename.restriction] at eq;
      try { contradiction },
      case choice {
        cases rename.inj inj eq, from rfl,
      },
    end
  | Γ Δ _ ρ inj (ν(M) A) B eq := begin
      cases B;
      simp only [rename.nil, rename.invoke, rename.parallel, rename.choice, rename.restriction] at eq;
      try { contradiction },
      case restriction {
        rcases eq with ⟨ ⟨ _ ⟩, eqB ⟩,
        cases (rename.inj (name.ext.inj inj) (eq_of_heq eqB)),
        from rfl,
      }
    end

  | Γ Δ _ ρ inj whole.empty B eq := begin
      cases B;
      simp only [rename.empty, rename.cons] at eq;
      contradiction,
    end
  | Γ Δ _ ρ inj (whole.cons π A As) B eq := begin
      cases B;
      simp only [rename.empty, rename.cons] at eq;
      try { contradiction },
      case whole.cons : f π₂ B Bs {
        rcases eq with ⟨ ⟨ _ ⟩, eqπ, eqA, eqAs ⟩,
        cases prefix_expr.rename.inj inj (eq_of_heq eqπ),
        cases rename.inj inj eqAs,
        cases (rename.inj (prefix_expr.ext.inj π inj) (eq_of_heq eqA)),
        from rfl,
      }
    end

end rename_equations

/- Show parallel can be converted to/from a list (though not isomorphic). -/
namespace parallel
  /-- Unfold a parallel composition, turning it into a list of non-nil species. -/
  def to_list {Γ} : species ℍ ω Γ → list (species ℍ ω Γ)
  | nil := []
  | (A |ₛ B) := to_list A ++ to_list B
  | A := [A]

  /-- Re-fold a list of species, turning it back into a parallel composition. -/
  def from_list {Γ} : list (species ℍ ω Γ) → species ℍ ω Γ
  | [] := nil
  | [A] := A
  | (A :: As) := A |ₛ (from_list As)

  instance lift_to {Γ} : has_lift (species ℍ ω Γ) (list (species ℍ ω Γ)) := ⟨ to_list ⟩
  instance lift_from {Γ} : has_lift (list (species ℍ ω Γ)) (species ℍ ω Γ) := ⟨ from_list ⟩

  @[simp]
  lemma rename_from_list {Γ Δ} (ρ : name Γ → name Δ) :
    ∀ (As : list (species ℍ ω Γ))
    , rename ρ (from_list As) = from_list (list.map (rename ρ) As)
  | [] := rename.nil
  | [M] := rfl
  | (M :: M' :: Ms) := begin
    simp only [from_list, rename.parallel, list.map],
    from ⟨ rfl, rename_from_list (M' :: Ms) ⟩
  end

  /-- to_list should contian no non-nil elements. -/
  lemma to_list_nonnil {Γ}: ∀ (A : species ℍ ω Γ), nil ∉ to_list A
  | A := begin
    known_induction whole @whole.rec_on ℍ ω
      (λ k c A, begin
        cases k,
        case kind.species { from nil ∉ to_list A },
        case kind.choices { from true },
      end) kind.species Γ A,

    case nil : Γ mem { unfold to_list at mem, from list.not_mem_nil nil mem },
    case parallel : Γ A B iha ihb mem {
      unfold to_list at mem,
      from or.elim (list.mem_append.mp mem) iha ihb,
    },

    -- All remaining species and choices.
    repeat {
      intros, simp only [to_list, has_mem.mem, list.mem],
      assume mem, cases mem; contradiction
    },
    repeat { intros, from true.intro },
  end

  /-- to_list should contian no parallel elements. -/
  lemma to_list_nonparallel : ∀ {Γ} (A B₁ B₂  : species ℍ ω Γ), (B₁ |ₛ B₂) ∉ to_list A
  | Γ nil B₁ B₂ mem := by { unfold to_list at mem, cases mem }
  | Γ (A |ₛ B) B₁ B₂ mem := begin
    unfold to_list at mem,
    cases list.mem_append.mp mem;
    from to_list_nonparallel _ B₁ B₂ h,
  end
  | Γ (apply D as) B₁ B₂ mem := begin
    unfold to_list at mem, cases mem,
    contradiction, from mem,
  end
  | Γ (Σ# As) B₁ B₂ mem := begin
    unfold to_list at mem, cases mem,
    contradiction, from mem,
  end
  | Γ (ν(M) A) B₁ B₂ mem := begin
    unfold to_list at mem, cases mem,
    contradiction, from mem,
  end
end parallel

end species

/- Re-export all the definitions. Don't ask - apparently export within
   namespaces is a little broken. -/
export species (renaming
  whole.nil → species.nil
  whole.apply → species.apply
  whole.parallel → species.parallel
  whole.restriction → species.restriction
  whole.choice → species.choice
  species → species
)

/-- A quotient of all structurally congruent species. -/
@[nolint has_inhabited_instance]
def species' (ℍ : Type) (ω Γ : context) [r : setoid (species ℍ ω Γ)] := quotient r

end cpi

/- Re-export all the definitions. Don't ask - apparently export within
   namespaces is a little broken. -/
export cpi.species (renaming
  whole.nil → cpi.species.nil
  whole.apply → cpi.species.apply
  whole.parallel → cpi.species.parallel
  whole.restriction → cpi.species.restriction
  whole.choice → cpi.species.choice
  species → cpi.species
)

#lint-


import Mathlib.Data.Nat.Basic

theorem rangeDecompose (start mid stop : ℕ) (hs : start ≤ mid ∧ mid ≤ stop)
  {f : ℕ → β → Id (ForInStep β)} :
  STD.forIn (mkRange' start stop) init f =
    STD.forIn (mkRange' mid stop) (Id.run (STD.forIn (mkRange' start mid) init f)) f := by
  sorry