example : Id Nat := do
  let mut x := 1
  have x : Nat := 2
  x


import for_mathlib.algebra.homology.trunc

noncomputable theory

open category_theory category_theory.limits category_theory.category
open_locale zero_object

@[simp]
lemma category_theory.epi_comp_left_iff_epi {C : Type*} [category C]
  {X₁ X₂ X₃ : C} (f : X₁ ⟶ X₂) (g : X₂ ⟶ X₃) [epi f]:
  epi (f ≫ g) ↔ epi g :=
begin
  split,
  { apply epi_of_epi, },
  { introI,
    apply epi_comp, },
end

@[simp]
lemma category_theory.epi_comp_right_iff_epi {C : Type*} [category C]
  {X₁ X₂ X₃ : C} (f : X₁ ⟶ X₂) (g : X₂ ⟶ X₃) [is_iso g] :
  epi (f ≫ g) ↔ epi f :=
begin
  split,
  { introI,
    exact ⟨λ Z h₁ h₂ eq, by simpa only [← cancel_epi (inv g), ← cancel_epi (f ≫ g),
      assoc, is_iso.hom_inv_id_assoc] using eq⟩, },
  { introI,
    apply epi_comp, },
end

@[simp]
lemma category_theory.mono_comp_right_iff_mono {C : Type*} [category C]
  {X₁ X₂ X₃ : C} (f : X₁ ⟶ X₂) (g : X₂ ⟶ X₃) [mono g] :
  mono (f ≫ g) ↔ mono f :=
begin
  split,
  { apply mono_of_mono, },
  { introI,
    apply mono_comp, },
end

@[simp]
lemma category_theory.mono_comp_left_iff_mono {C : Type*} [category C]
  {X₁ X₂ X₃ : C} (f : X₁ ⟶ X₂) (g : X₂ ⟶ X₃) [is_iso f] :
  mono (f ≫ g) ↔ mono g :=
begin
  split,
  { introI,
    exact ⟨λ Z h₁ h₂ eq, by simpa only [← cancel_mono (inv f), ← cancel_mono (f ≫ g),
      assoc, is_iso.inv_hom_id_assoc] using eq⟩, },
  { introI,
    apply mono_comp, },
end

open category_theory category_theory.limits category_theory.category

namespace category_theory.short_complex

@[simps]
def homology_map_data.of_zeros_of_limit_kernel_fork {C : Type*} [category C] [has_zero_morphisms C]
  {S₁ S₂ : short_complex C} (φ : S₁ ⟶ S₂) (hf₁ : S₁.f = 0) (hg₁ : S₁.g = 0) (hf₂ : S₂.f = 0)
  (c : kernel_fork S₂.g) (hc : is_limit c) :
  homology_map_data φ
    (homology_data.of_zeros S₁ hf₁ hg₁)
    (homology_data.of_limit_kernel_fork S₂ hf₂ c hc) :=
begin
  let α := hc.lift (kernel_fork.of_ι φ.τ₂ (by rw [φ.comm₂₃, hg₁, zero_comp])),
  have hα : α ≫ c.ι = φ.τ₂ := by simp only [fork.is_limit.lift_ι', kernel_fork.ι_of_ι],
  exact { left :=
    { φK := α,
      φH := α,
      commf'' := by { dsimp, simp only [hf₁, left_homology_data.of_zeros_f',
        zero_comp, left_homology_data.of_limit_kernel_fork_f', comp_zero], }, },
    right :=
    { φQ := φ.τ₂,
      φH := α,
      commg'' := by { dsimp, simp only [φ.comm₂₃, right_homology_data.of_zeros_g',
        right_homology_data.of_limit_kernel_fork_f'], }, }, }
end

instance is_iso_cycles_map_of_is_iso_of_mono {C : Type*} [category C] [has_zero_morphisms C]
  {S₁ S₂ : short_complex C} (φ : S₁ ⟶ S₂) [S₁.has_left_homology] [S₂.has_left_homology]
  [is_iso φ.τ₂] [mono φ.τ₃] :
  is_iso (cycles_map φ) :=
begin
  refine ⟨⟨S₁.lift_cycles (S₂.cycles_i ≫ inv φ.τ₂) _, _, _⟩⟩,
  { simp only [← cancel_mono φ.τ₃, assoc, ← φ.comm₂₃, is_iso.inv_hom_id_assoc, lift_cycles_i,
      cycles_i_g, zero_comp], },
  { simp only [← cancel_mono S₁.cycles_i, assoc, lift_cycles_i, cycles_map_i_assoc,
      is_iso.hom_inv_id, comp_id, id_comp], },
  { simp only [← cancel_mono S₂.cycles_i, assoc, is_iso.inv_hom_id, comp_id,
      lift_cycles_comp_cycles_map, lift_cycles_i, id_comp], },
end

instance is_iso_cycles_co_map_of_is_iso_of_epi {C : Type*} [category C] [has_zero_morphisms C]
  {S₁ S₂ : short_complex C} (φ : S₁ ⟶ S₂) [S₁.has_right_homology] [S₂.has_right_homology]
  [is_iso φ.τ₂] [epi φ.τ₁] :
  is_iso (cycles_co_map φ) :=
begin
  refine ⟨⟨S₂.desc_cycles_co (inv φ.τ₂ ≫ S₁.p_cycles_co) _, _ ,_⟩⟩,
  { simp only [← cancel_epi φ.τ₁, φ.comm₁₂_assoc, is_iso.hom_inv_id_assoc,
      f_cycles_co_p, comp_zero], },
  { simp only [←cancel_epi S₁.p_cycles_co, is_iso.hom_inv_id_assoc,
      p_cycles_co_map_assoc, p_desc_cycles_co, comp_id], },
  { simp only [←cancel_epi S₂.p_cycles_co, p_desc_cycles_co_assoc, assoc, p_cycles_co_map,
      is_iso.inv_hom_id_assoc, comp_id], },
end

instance mono_cycles_map_of_mono_of_mono {C : Type*} [category C] [has_zero_morphisms C]
  {S₁ S₂ : short_complex C} (φ : S₁ ⟶ S₂) [S₁.has_homology] [S₂.has_homology]
  [mono φ.τ₂] [mono φ.τ₃] : mono (cycles_map φ) :=
begin
  simp only [← mono_comp_right_iff_mono _ S₂.cycles_i, cycles_map_i, mono_comp_right_iff_mono],
  apply_instance,
end

instance epi_cycles_co_map_of_epi_of_epi {C : Type*} [category C] [has_zero_morphisms C]
  {S₁ S₂ : short_complex C} (φ : S₁ ⟶ S₂) [S₁.has_homology] [S₂.has_homology]
  [epi φ.τ₂] [epi φ.τ₁] : epi (cycles_co_map φ) :=
begin
  simp only [← epi_comp_left_iff_epi S₁.p_cycles_co, p_cycles_co_map, epi_comp_left_iff_epi],
  apply_instance,
end

lemma quasi_iso_iff_exact_and_mono {C : Type*} [category C] [abelian C]
  {S₁ S₂ : short_complex C}
  (φ : S₁ ⟶ S₂) (hf₁ : S₁.f = 0) (hg₁ : S₁.g = 0) (hf₂ : S₂.f = 0) :
  short_complex.quasi_iso φ ↔
    (mk φ.τ₂ S₂.g (by rw [φ.comm₂₃, hg₁, zero_comp])).exact ∧ mono φ.τ₂ :=
begin
  rw [exact_iff_epi_to_cycles,
    (homology_map_data.of_zeros_of_limit_kernel_fork φ hf₁ hg₁ hf₂
    _ S₂.cycles_is_kernel).left.quasi_iso_iff,
    homology_map_data.of_zeros_of_limit_kernel_fork_left_φH],
  have w : φ.τ₂ ≫ S₂.g = 0 := by rw [φ.comm₂₃, hg₁, zero_comp],
  let S := mk φ.τ₂ S₂.g w,
  change is_iso (S₂.lift_cycles φ.τ₂ w) ↔ epi S.to_cycles ∧ _,
  let γ : S₂ ⟶ S :=
  { τ₁ := 0,
    τ₂ := 𝟙 _,
    τ₃ := 𝟙 _,
    comm₁₂' := by simp only [hf₂, zero_comp], },
  have eq : S₂.lift_cycles φ.τ₂ w ≫ cycles_map γ = S.to_cycles,
  { simp only [← cancel_mono S.cycles_i, comp_id, lift_cycles_comp_cycles_map,
      lift_cycles_i, to_cycles_i], },
  conv_rhs { rw ← S₂.lift_cycles_i φ.τ₂ w, },
  simp only [is_iso_iff_mono_and_epi, ← eq, epi_comp_right_iff_epi,
    mono_comp_right_iff_mono],
  tauto,
end

end category_theory.short_complex

open category_theory category_theory.limits category_theory.category

namespace cochain_complex

section

variables {C : Type*} [category C] {a b : ℤ} (h : a+1=b)
  [has_zero_morphisms C] [has_zero_object C] {A B : C} (φ : A ⟶ B)

namespace double

include h φ
@[nolint unused_arguments]
def X (n : ℤ) : C := if n = a then A else if n = b then B else 0
omit h φ

def X_iso₁ {n : ℤ} (hn : n = a) :
  X h φ n ≅ A :=
eq_to_iso (by { subst hn, dsimp [X], simp, })

def X_iso₂ {n : ℤ} (hn : n = b) :
  X h φ n ≅ B :=
eq_to_iso (begin
  subst hn,
  simp only [X, if_neg (show ¬n=a, by linarith), eq_self_iff_true, if_true, ite_eq_right_iff],
end)

lemma X_is_zero (n : ℤ) (hn₁ : n ≠ a) (hn₂ : n ≠ b) :
  is_zero (X h φ n) :=
by simpa only [X, if_neg hn₁, if_neg hn₂] using is_zero_zero C

def d (i j : ℤ) :
  X h φ i ⟶ X h φ j :=
begin
  by_cases hi : i = a,
  { by_cases hj : j = b,
    { exact (X_iso₁ h φ hi).hom ≫ φ ≫ (X_iso₂ h φ hj).inv, },
    { exact 0, }, },
  { exact 0, },
end

lemma d_eq' {i j : ℤ} (hi : i = a) (hj : j = b) :
  double.d h φ i j = (X_iso₁ h φ hi).hom ≫ φ ≫ (X_iso₂ h φ hj).inv :=
by simp only [d, dif_pos hi, dif_pos hj]

@[simp]
lemma d_eq :
  double.d h φ a b = (X_iso₁ h φ rfl).hom ≫ φ ≫ (X_iso₂ h φ rfl).inv :=
d_eq' _ _ rfl rfl

lemma d_eq_zero₁ {i j : ℤ} (hi : i ≠ a) :
  double.d h φ i j = 0 :=
by simp only [d, dif_neg hi]

lemma d_eq_zero₂ {i j : ℤ} (hj : j ≠ b) :
  double.d h φ i j = 0 :=
begin
  by_cases hi : i = a,
  { simp only [d, dif_pos hi, dif_neg hj], },
  { simp only [d_eq_zero₁ _ _ hi], },
end

@[simp, reassoc]
lemma d_comp_d {i j k : ℤ} :
  double.d h φ i j ≫ double.d h φ j k = 0 :=
begin
  by_cases hi : i = a,
  { by_cases hj : j = b,
    { have hk : j ≠ a := by linarith,
      rw [d_eq_zero₁ _ _ hk, comp_zero], },
    { simp only [d_eq_zero₂ _ _ hj, zero_comp], }, },
  { simp only [d_eq_zero₁ _ _ hi, zero_comp], },
end

end double

@[simps]
def double : cochain_complex C ℤ :=
{ X := double.X h φ,
  d := λ i j, double.d h φ i j,
  shape' := λ i j hij, begin
    change i+1 ≠ j at hij,
    by_cases hi : i = a,
    { rw double.d_eq_zero₂,
      exact λ hj, hij (by linarith), },
    { rw double.d_eq_zero₁ _ _ hi, },
  end, }

namespace double

section desc

variables (K : cochain_complex C ℤ) (fa : A ⟶ K.X a) (fb : B ⟶ K.X b)
  (comm : fa ≫ K.d a b = φ ≫ fb) {c : ℤ} (hc : b+1 = c)
  (w : fb ≫ K.d b c = 0)

include fa fb

def desc.f (n : ℤ) : (double h φ).X n ⟶ K.X n :=
begin
  by_cases ha : n = a,
  { exact (double.X_iso₁ h φ ha).hom ≫ fa ≫ eq_to_hom (by rw ha), },
  { by_cases hb : n = b,
    { exact (double.X_iso₂ h φ hb).hom ≫ fb ≫ eq_to_hom (by rw hb), },
    { exact 0, }, },
end

@[simp]
lemma desc.f₁ : desc.f h φ K fa fb a = (double.X_iso₁ h φ rfl).hom ≫ fa :=
by simp only [desc.f, dif_pos rfl, eq_to_hom_refl, comp_id]

@[simp]
lemma desc.f₂ : desc.f h φ K fa fb b = (double.X_iso₂ h φ rfl).hom ≫ fb :=
by simp only [desc.f, dif_neg (show b ≠ a, by linarith), dif_pos rfl, eq_to_hom_refl, comp_id]

lemma desc.f_eq_zero (n : ℤ) (ha : n ≠ a) (hb : n ≠ b) : desc.f h φ K fa fb n = 0 :=
by simp only [desc.f, dif_neg ha, dif_neg hb]

include comm w hc

@[simps]
def desc : double h φ ⟶ K :=
{ f := desc.f h φ K fa fb,
  comm' := λ i j hij, begin
    change i+1 = j at hij,
    by_cases ha : i = a,
    { have hb : j = b := by linarith,
      substs ha hb,
      simp only [desc.f₁, assoc, double_d, d_eq, desc.f₂, iso.inv_hom_id_assoc,
        iso.cancel_iso_hom_left, comm], },
    { simp only [double_d, d_eq_zero₁ h _ ha, zero_comp],
      by_cases hb : i = b,
      { have hc : j = c := by linarith,
        substs hc hb,
        simp only [desc.f₂, assoc, w, comp_zero], },
      { rw [desc.f_eq_zero _ _ _ _ _ _ ha hb, zero_comp], }, },
  end, }

end desc

section lift

variables (K : cochain_complex C ℤ) (fa : K.X a ⟶ A) (fb : K.X b ⟶ B)
  (comm : fa ≫ φ = K.d a b ≫ fb) {c : ℤ} (hc : c+1 = a)
  (w : K.d c a ≫ fa = 0)

include fa fb

def lift.f (n : ℤ) : K.X n ⟶ (double h φ).X n :=
begin
  by_cases ha : n = a,
  { exact eq_to_hom (by rw ha) ≫ fa ≫ (double.X_iso₁ h φ ha).inv, },
  { by_cases hb : n = b,
    { exact eq_to_hom (by rw hb) ≫ fb ≫ (double.X_iso₂ h φ hb).inv, },
    { exact 0, }, },
end

@[simp]
lemma lift.f₁ : lift.f h φ K fa fb a = fa ≫ (double.X_iso₁ h φ rfl).inv :=
by simp only [lift.f, dif_pos rfl, eq_to_hom_refl, id_comp]

@[simp]
lemma lift.f₂ : lift.f h φ K fa fb b = fb ≫ (double.X_iso₂ h φ rfl).inv :=
by simp only [lift.f, dif_neg (show b ≠ a, by linarith), dif_pos rfl, eq_to_hom_refl, id_comp]

lemma lift.f_eq_zero (n : ℤ) (ha : n ≠ a) (hb : n ≠ b) : lift.f h φ K fa fb n = 0 :=
by simp only [lift.f, dif_neg ha, dif_neg hb]

include comm w hc

@[simps]
def lift : K ⟶ double h φ :=
{ f := lift.f h φ K fa fb,
  comm' := λ i j hij, begin
    change i+1 = j at hij,
    by_cases hb : j = b,
    { have ha : i = a := by linarith,
      substs ha hb,
      simp only [lift.f₁, double_d, d_eq, assoc, iso.inv_hom_id_assoc, lift.f₂,
        iso.cancel_iso_inv_right_assoc, comm], },
    { simp only [double_d, d_eq_zero₂ h _ hb, comp_zero],
      by_cases ha : j = a,
      { have hc : i = c := by linarith,
        substs hc ha,
        simp only [lift.f₁, reassoc_of w, zero_comp], },
      { rw [lift.f_eq_zero _ _ _ _ _ _ ha hb, comp_zero], }, },
  end, }

end lift

section map

variables (φ) {A' B' : C} (φ' : A' ⟶ B') (α : A ⟶ A') (β : B ⟶ B') (comm : φ ≫ β = α ≫ φ')

include comm

def map : double h φ ⟶ double h φ' :=
double.desc h φ _ (α ≫ (double.X_iso₁ h φ' rfl).inv)
  (β  ≫ (double.X_iso₂ h φ' rfl).inv) (by tidy) rfl
  (is_zero.eq_of_tgt (double.X_is_zero h φ' (b+1) (by linarith) (by linarith)) _ _)

@[simp]
lemma map_f₁ :
  (map h φ φ' α β comm).f a = (double.X_iso₁ h φ rfl).hom ≫ α ≫ (double.X_iso₁ h φ' rfl).inv :=
by simp only [map, desc_f, desc.f₁]

@[simp]
lemma map_f₂ :
  (map h φ φ' α β comm).f b = (double.X_iso₂ h φ rfl).hom ≫ β ≫ (double.X_iso₂ h φ' rfl).inv :=
by simp only [map, desc_f, desc.f₂]

end map

variables {h φ}

@[ext]
lemma ext {K : cochain_complex C ℤ} (f₁ f₂ : double h φ ⟶ K)
  (ha : f₁.f a = f₂.f a) (hb : f₁.f b = f₂.f b) : f₁ = f₂ :=
begin
  ext n,
  by_cases ha' : n = a,
  { subst ha',
    exact ha, },
  { by_cases hb' : n = b,
    { subst hb',
      exact hb, },
    { apply is_zero.eq_of_src,
      exact double.X_is_zero h φ _ ha' hb', }, },
end

@[ext]
lemma ext' {K : cochain_complex C ℤ} (f₁ f₂ : K ⟶ double h φ)
  (ha : f₁.f a = f₂.f a) (hb : f₁.f b = f₂.f b) : f₁ = f₂ :=
begin
  ext n,
  by_cases ha' : n = a,
  { subst ha',
    exact ha, },
  { by_cases hb' : n = b,
    { subst hb',
      exact hb, },
    { apply is_zero.eq_of_tgt,
      exact double.X_is_zero h φ _ ha' hb', }, },
end

@[simp, reassoc]
lemma w_from {K : cochain_complex C ℤ} (f : double h φ ⟶ K) (c : ℤ) :
  f.f b ≫ K.d b c = 0 :=
begin
  by_cases hc : b+1 = c,
  { rw [f.comm b c, double_d, d_eq_zero₁ h φ (show b ≠ a, by linarith), zero_comp], },
  { rw [K.shape _ _ hc, comp_zero], },
end

@[simp, reassoc]
lemma w_to {K : cochain_complex C ℤ} (f : K ⟶ double h φ) (c : ℤ) :
  K.d c a ≫ f.f a = 0 :=
begin
  by_cases hc : c+1 = a,
  { rw [← f.comm c a, double_d, d_eq_zero₂ h φ (show a ≠ b, by linarith), comp_zero], },
  { rw [K.shape _ _ hc, zero_comp], },
end

variables (h φ)

@[simps]
def ι : (homological_complex.single _ _ b).obj B ⟶ double h φ :=
double.lift h φ _ 0 (homological_complex.single_obj_X_self _ _ _ _).hom (by simp)
  (sub_add_cancel a 1) (by simp)

@[simps]
def π : double h φ ⟶ (homological_complex.single _ _ a).obj A :=
double.desc h φ _ (homological_complex.single_obj_X_self _ _ _ _).inv 0 (by simp) rfl (by simp)

@[simp, reassoc]
lemma ι_π : ι h φ ≫ π h φ = 0 :=
begin
  ext n,
  by_cases ha : n = a,
  { subst ha,
    simp only [homological_complex.comp_f, ι_f, lift.f₁, zero_comp,
      homological_complex.zero_apply], },
  { apply is_zero.eq_of_tgt,
    dsimp [homological_complex.single],
    rw [if_neg ha],
    exact is_zero_zero C, },
end

end double

end

section preadditive

namespace double

variables {C : Type*} [category C] [preadditive C] [has_zero_object C]
  {a b : ℤ} (h : a+1=b) {A B A' B' : C} {φ : A ⟶ B} {φ' : A' ⟶ B'}

def homotopy_mk (f₁ f₂ : double h φ ⟶ double h φ') (γ : B ⟶ A')
  (hγ₁ : f₁.f a = (double h φ).d a b ≫ (X_iso₂ h φ rfl).hom ≫
    γ ≫ (X_iso₁ h φ' rfl).inv + f₂.f a)
  (hγ₂ : f₁.f b = ((X_iso₂ h φ rfl).hom ≫ γ ≫ (X_iso₁ h φ' rfl).inv) ≫
    (double h φ').d a b + f₂.f b) :
  homotopy f₁ f₂ :=
{ hom := λ i j, begin
    by_cases hb : i = b,
    { by_cases ha : j = a,
      { exact (X_iso₂ h φ hb).hom ≫ γ ≫ (X_iso₁ h φ' ha).inv, },
      { exact 0,}, },
    { exact 0, },
  end,
  zero' := λ i j (hij : j+1 ≠ i), begin
    by_cases hb : i = b,
    { rw dif_pos hb,
      by_cases ha : j = a,
      { exfalso,
        apply hij,
        rw [ha, hb, h], },
      { rw dif_neg ha, }, },
    { rw dif_neg hb, },
  end,
  comm := λ i, begin
    have h' : (complex_shape.up ℤ).rel a b := h,
    by_cases ha : i = a,
    { subst ha,
      have h'' : (complex_shape.up ℤ).rel (i-1) i := sub_add_cancel i 1,
      simp only [d_next_eq _ h', prev_d_eq _ h'', dif_pos rfl,
        dif_neg (show i ≠ b, by linarith), zero_comp, add_zero, hγ₁], },
    { by_cases hb : i = b,
      { subst hb,
        have h'' : (complex_shape.up ℤ).rel i (i+1) := rfl,
        simp only [prev_d_eq _ h', d_next_eq _ h'', dif_neg (succ_ne_self i), dif_pos rfl,
          comp_zero, zero_add, hγ₂], },
      { exact is_zero.eq_of_src (X_is_zero h φ i ha hb) _ _, }, },
  end, }

/-- should be moved -/
lemma four_cases {a b : ℤ} (h : a+1=b) (n : ℤ) :
  (n < a ∨ b < n) ∨ n = a ∨ n = b :=
begin
  by_cases h₁ : n < a,
  { exact or.inl (or.inl h₁), },
  { by_cases h₂ : b < n,
    { exact or.inl (or.inr h₂), },
    { refine or.inr _,
      simp only [not_lt] at h₁ h₂,
      cases h₁.lt_or_eq with h₃ h₃,
      { cases h₂.lt_or_eq with h₄ h₄,
        { exfalso,
          linarith, },
        { exact or.inr h₄, }, },
      { exact or.inl h₃.symm, }, }, },
end

end double

end preadditive

section abelian

variables {C : Type*} [category C] [abelian C] {a b : ℤ} (h : a+1=b) {A B E : C} (φ : A ⟶ B)
  {i : B ⟶ E} {p : E ⟶ A} (w : i ≫ p = 0)

instance double_strictly_le :
  (double h φ).is_strictly_le b :=
⟨λ n hn, double.X_is_zero h φ n (by linarith) (by linarith)⟩

instance double_strictly_ge :
  (double h φ).is_strictly_ge a :=
⟨λ n hn, double.X_is_zero h φ n (by linarith) (by linarith)⟩

include h

lemma double.is_le_iff_epi : (double h φ).is_le a ↔ epi φ :=
begin
  rw [is_le_iff_of_is_le_next (double h φ) h, ← short_complex.exact_iff_is_zero_homology,
    short_complex.exact_iff_epi],
  { have ha : a = (complex_shape.up ℤ).prev b := by { rw prev, linarith, },
    subst ha,
    change epi (double.d _ _ _ _) ↔ _,
    rw double.d_eq,
    split,
    { intro hφ,
      haveI := @epi_of_epi _ _ _ _ _ _ _ hφ,
      have eq := φ ≫= (double.X_iso₂ h φ rfl).inv_hom_id,
      rw [comp_id, ← assoc] at eq,
      rw ← eq,
      apply epi_comp, },
    { introI,
      haveI := epi_comp φ (double.X_iso₂ h φ rfl).inv,
      apply epi_comp, }, },
  { apply is_zero.eq_of_tgt,
    exact double.X_is_zero h φ _ (by { rw [next], linarith, })
      (by simpa only [next] using succ_ne_self b), },
end

instance double_le [epi φ] :
  (double h φ).is_le a :=
by { rw double.is_le_iff_epi, apply_instance, }

lemma double.is_ge_iff_mono : (double h φ).is_ge b ↔ mono φ :=
begin
  rw [is_ge_iff_of_is_ge_prev (double h φ) h, ← short_complex.exact_iff_is_zero_homology,
    short_complex.exact_iff_mono],
  { have hb : b = (complex_shape.up ℤ).next a := by rw [next, h],
    subst hb,
    change mono (double.d _ _ _ _) ↔ _,
    rw double.d_eq,
    split,
    { intro hφ,
      rw ← assoc at hφ,
      haveI := @mono_of_mono _ _ _ _ _ _ _ hφ,
      have eq := (double.X_iso₁ h φ rfl).inv_hom_id =≫ φ,
      rw [id_comp, assoc] at eq,
      rw ← eq,
      apply mono_comp, },
    { introI,
      haveI := mono_comp φ (double.X_iso₂ h φ rfl).inv,
      apply mono_comp, }, },
  { apply is_zero.eq_of_src,
    exact double.X_is_zero h φ _ (by simpa only [prev] using pred_ne_self a)
      (by { rw [prev], linarith, }), },
end

instance double_ge [mono φ] :
  (double h φ).is_ge b :=
by { rw double.is_ge_iff_mono, apply_instance, }

include w

def double.σ : (double h i) ⟶ (homological_complex.single _ (complex_shape.up ℤ) b).obj A :=
lift_single _ _ ((double.X_iso₂ h i rfl).hom ≫ p ≫
  (homological_complex.single_obj_X_self _ _ _ A).inv) _ h
begin
  dsimp,
  simp only [double.d_eq, assoc, iso.inv_hom_id_assoc, preadditive.is_iso.comp_left_eq_zero,
    reassoc_of w, zero_comp],
end

@[simp]
lemma double.σ_f₁ : (double.σ h w).f a = 0 :=
begin
  dsimp [double.σ, lift_single],
  rw dif_neg (show ¬ a=b, by linarith),
end

@[simp]
lemma double.σ_f₂ :
  (double.σ h w).f b = (double.X_iso₂ h i rfl).hom ≫ p
    ≫ (homological_complex.single_obj_X_self C (complex_shape.up ℤ) b A).inv :=
begin
  dsimp only [double.σ, lift_single],
  rw dif_pos rfl,
end

def double.σ' : (homological_complex.single _ (complex_shape.up ℤ) a).obj B ⟶
  double h p :=
begin
  refine desc_single _ _ ((homological_complex.single_obj_X_self _ _ _ B).hom ≫ i ≫
    (double.X_iso₁ h p rfl).inv) _ h _,
  { dsimp,
    simp only [double.d_eq, assoc, iso.inv_hom_id_assoc, preadditive.is_iso.comp_left_eq_zero,
      reassoc_of w, zero_comp], },
end

omit w

def double.homotopy_πσ'_σι : homotopy (double.π h i ≫ double.σ' h w)
  (-double.σ h w ≫ double.ι h p) :=
double.homotopy_mk _ _ _ (𝟙 _)
  (by { dsimp, simp [double.π, double.σ', double.ι], })
  (by { dsimp, simp [double.π, double.σ, double.ι], })

lemma double.quasi_iso_σ' (ex : (short_complex.mk _ _ w).short_exact) :
  quasi_iso (double.σ' h w) :=
begin
  have hb : b = (complex_shape.up ℤ).next a := by rw [next, h],
  subst hb,
  haveI := ex.mono_f,
  haveI := ex.epi_g,
  rw quasi_iso_iff_of_is_le_of_is_ge (double.σ' h w) a,
  apply short_complex.quasi_iso.of_kernel_fork _ _ _,
  { refine ⟨λ Z f₁ f₂ eq, is_zero.eq_of_src _ _ _⟩,
    refine double.X_is_zero h p _
      (by { rw prev, linarith, })
      (by { rw prev, linarith, }), },
  { refl, },
  { let e : parallel_pair p 0 ≅
      parallel_pair (((double h) p).sc' a).g 0 :=
      parallel_pair.ext (double.X_iso₁ h p rfl).symm
        ((double.X_iso₂ h p rfl).symm) (by tidy) (by tidy),
    equiv_rw (is_limit.postcompose_inv_equiv e _).symm,
    refine is_limit.of_iso_limit ex.exact.f_is_kernel _,
    refine fork.ext (homological_complex.single_obj_X_self _ (complex_shape.up ℤ) a B).symm _,
    dsimp only [cones.postcompose, fork.ι],
    dsimp [e, double.σ'],
    simp only [desc_single_f, assoc, iso.inv_hom_id, comp_id, eq_to_hom_trans_assoc,
      eq_to_hom_refl, id_comp], },
end

lemma double.quasi_iso_σ (ex : (short_complex.mk _ _ w).short_exact) :
  quasi_iso (double.σ h w) :=
begin
  have ha : a = (complex_shape.up ℤ).prev b := by { rw prev, linarith, },
  subst ha,
  haveI := ex.mono_f,
  haveI := ex.epi_g,
  rw quasi_iso_iff_of_is_le_of_is_ge (double.σ h w) b,
  apply short_complex.quasi_iso.of_cokernel_cofork _ _ _,
  { refine ⟨λ Z f₁ f₂ eq, is_zero.eq_of_tgt _ _ _⟩,
    refine double.X_is_zero h i _
      (by { rw [next, prev], linarith, })
      (by { rw [next], linarith, }), },
  { refl, },
  { dsimp [double.σ],
    let e : parallel_pair i 0 ≅
      parallel_pair (((double h) i).sc' b).f 0 :=
      parallel_pair.ext (double.X_iso₁ h i rfl).symm (double.X_iso₂ h i rfl).symm
        (by tidy) (by tidy),
    equiv_rw (is_colimit.precompose_hom_equiv e _).symm,
    refine is_colimit.of_iso_colimit ex.exact.g_is_cokernel _,
    refine cofork.ext (homological_complex.single_obj_X_self _ (complex_shape.up ℤ) b A).symm _,
    dsimp only [cocones.precompose, cofork.π],
    dsimp [e, double.σ],
    simp only [lift_single_f, iso.inv_hom_id_assoc], },
end

lemma double.is_iso_iff {K L : cochain_complex C ℤ} [K.is_strictly_le b] [K.is_strictly_ge a]
  [L.is_strictly_le b] [L.is_strictly_ge a] (φ : K ⟶ L) :
  is_iso φ ↔ (is_iso (φ.f a) ∧ is_iso (φ.f b)) :=
begin
  split,
  { introI,
    split; exact (infer_instance : is_iso ((homological_complex.eval _ _ _).map φ)), },
  { intro hφ,
    haveI : ∀ (n : ℤ), is_iso (φ.f n),
    { intro n,
      rcases double.four_cases h n with ⟨h' | h'⟩ | ⟨h' | h'⟩,
      { refine ⟨⟨0, (is_strictly_ge.is_zero K a _ h').eq_of_src _ _,
          (is_strictly_ge.is_zero L a _ h').eq_of_src _ _⟩⟩, },
      { refine ⟨⟨0, (is_strictly_le.is_zero K b _ h').eq_of_src _ _,
          (is_strictly_le.is_zero L b _ h').eq_of_src _ _⟩⟩, },
      all_goals { unfreezingI { subst h', }, tauto, }, },
    apply homological_complex.hom.is_iso_of_components, },
end

lemma exists_iso_double (K : cochain_complex C ℤ) [K.is_strictly_le b] [K.is_strictly_ge a] :
  ∃ (A B : C) (φ : A ⟶ B), nonempty (K ≅ double h φ) :=
begin
  let α := double.lift h (K.d a b) K (𝟙 _) (𝟙 _) (by simp) (show (a-1)+1=a, by linarith)
      ((is_strictly_ge.is_zero K a (a-1) (by linarith)).eq_of_src _ _),
  haveI : is_iso α,
  { simp only [double.is_iso_iff h α, id_comp, double.lift_f, double.lift.f₁, double.lift.f₂],
    split; apply_instance, },
  exact ⟨_, _, K.d a b, ⟨as_iso α⟩⟩,
end

variables {X₁ X₂ X₃ : C}

@[simp]
def single_to_double (i : X₁ ⟶ X₂) (p : X₂ ⟶ X₃) (w : i ≫ p = 0) :
  ((homological_complex.single C _ a).obj X₁) ⟶ double h p :=
desc_single _ _  ((homological_complex.single_obj_X_self C
    (complex_shape.up ℤ) a X₁).hom ≫ i ≫ (double.X_iso₁ h p rfl).inv) _ h
    (by simp [reassoc_of w])

@[simp]
def single_to_double' (g : X₁ ⟶ X₃) (p : X₂ ⟶ X₃) :
  ((homological_complex.single C _ b).obj X₁) ⟶ double h p :=
   desc_single _ (double h p) ((homological_complex.single_obj_X_self C
    (complex_shape.up ℤ) b X₁).hom ≫ g ≫ (double.X_iso₂ h p rfl).inv) (b+1) rfl
    (is_zero.eq_of_tgt (double.X_is_zero h p (b+1) (by simp only [← h, add_assoc, ne.def,
      add_right_eq_self, add_self_eq_zero, one_ne_zero, not_false_iff]) (succ_ne_self b)) _ _)

variables {h φ}

lemma eq_single_to_double {Z : C} (f : ((homological_complex.single C _ a).obj Z) ⟶ double h φ) :
  ∃ (g : Z ⟶ A) (hg : g ≫ φ = 0), f = single_to_double h g φ hg :=
⟨(homological_complex.single_obj_X_self C
  (complex_shape.up ℤ) a Z).inv ≫ f.f a ≫ (double.X_iso₁ h φ rfl).hom,
  by simpa only [preadditive.is_iso.comp_left_eq_zero, double_d, double.d_eq,
  homological_complex.single_obj_d, zero_comp,
  iso.inv_hom_id, comp_id, assoc] using f.comm a b =≫ (double.X_iso₂ h φ rfl).hom,
  from_single_ext _ _ a (by simp)⟩

lemma eq_single_to_double' {Z : C} (f : ((homological_complex.single C _ b).obj Z) ⟶ double h φ) :
  ∃ (g : Z ⟶ B), f = single_to_double' h g φ :=
⟨(homological_complex.single_obj_X_self C
    (complex_shape.up ℤ) b Z).inv ≫ f.f b ≫ (double.X_iso₂ h φ rfl).hom,
    from_single_ext _ _ b (by simp)⟩

variables (h φ)

lemma double.is_zero_homology₁_iff :
  is_zero ((double h φ).homology a) ↔ mono φ :=
begin
  have hb : b = (complex_shape.up ℤ).next a := by { rw next, linarith, },
  subst hb,
  rw [← short_complex.exact_iff_is_zero_homology, short_complex.exact_iff_mono],
  { dsimp [homological_complex.short_complex_functor],
    have eq : homological_complex.d_from (double h φ) a = _ := double.d_eq h φ,
    simp only [eq, mono_comp_left_iff_mono, mono_comp_right_iff_mono], },
  { exact double.d_eq_zero₂ h φ (by linarith), }
end

lemma double.is_zero_homology₂_iff :
  is_zero ((double h φ).homology b) ↔ epi φ :=
begin
  have ha : a = (complex_shape.up ℤ).prev b := by { rw prev, linarith, },
  subst ha,
  rw [← short_complex.exact_iff_is_zero_homology, short_complex.exact_iff_epi],
  { dsimp [homological_complex.short_complex_functor],
    have eq : homological_complex.d_to (double h φ) b = _ := double.d_eq h φ,
    simp only [eq, ← assoc, epi_comp_right_iff_epi, epi_comp_left_iff_epi], },
  { exact double.d_eq_zero₁ h φ (by linarith), },
end

lemma is_iso_homology_map₁_single_to_double_iff_exact_and_mono
  (i : X₁ ⟶ X₂) (p : X₂ ⟶ X₃) (w : i ≫ p = 0) :
is_iso (homology_map (single_to_double h i p w) a) ↔
  (short_complex.mk _ _ w).exact ∧ mono i :=
begin
  erw is_iso_homology_map_iff_short_complex_quasi_iso,
  rw short_complex.quasi_iso_iff_exact_and_mono, rotate,
  { refl, },
  { refl, },
  { exact double.d_eq_zero₂ h p (by linarith), },
  apply iff.and,
  { apply short_complex.exact_iff_of_iso,
    have hb : (complex_shape.up ℤ).next a = b := by { rw next, linarith, },
    refine short_complex.mk_iso
      (homological_complex.single_obj_X_self  _ (complex_shape.up ℤ) _ X₁)
      (double.X_iso₁ h p rfl) (double.X_iso₂ h p hb) _ _ ,
    { dsimp,
      simp only [desc_single_f, assoc, iso.inv_hom_id, comp_id], },
    { dsimp,
      simpa only [← cancel_mono (double.X_iso₂ h p hb).inv, assoc, iso.hom_inv_id, comp_id,
        (double.d_eq' h p rfl hb).symm], }, },
  { simp only [single_to_double, homological_complex.short_complex_functor_map_τ₂,
      desc_single_f, mono_comp_left_iff_mono, mono_comp_right_iff_mono], },
end

variable {φ}

lemma single_to_double_quasi_iso_iff (i : X₁ ⟶ X₂) (p : X₂ ⟶ X₃) (w : i ≫ p = 0) :
  quasi_iso (single_to_double h i p w) ↔ (short_complex.mk _ _ w).short_exact :=
begin
  split,
  { intro hw,
    have hw' := (is_iso_homology_map₁_single_to_double_iff_exact_and_mono h i p w).1 (hw.is_iso a),
    haveI : mono i := hw'.2,
    haveI : epi p,
    { simp only [← double.is_zero_homology₂_iff h],
      haveI := hw.is_iso b,
      exact is_zero.of_iso (is_le.is_zero _ a _ (by linarith))
        (as_iso (homology_map (single_to_double h i p w) b)).symm, },
    exact short_complex.short_exact.mk hw'.1, },
  { intro hw,
    haveI := hw.epi_g,
    refine ⟨λ n, _⟩,
    rcases double.four_cases h n with hn | ⟨hn | hn⟩,
    { refine ⟨⟨0, is_zero.eq_of_src _ _ _, is_zero.eq_of_src _ _ _⟩⟩,
      { cases hn,
        { exact is_ge.is_zero _ _ _ hn, },
        { exact is_le.is_zero _ a n (by linarith), }, },
      { cases hn,
        { exact is_ge.is_zero _ _ _ hn, },
        { exact is_le.is_zero _ _ _ hn, }, }, },
    { subst hn,
      exact (is_iso_homology_map₁_single_to_double_iff_exact_and_mono h i p w).2 ⟨hw.exact, hw.mono_f⟩, },
    { subst hn,
      exact ⟨⟨0, is_zero.eq_of_src (is_le.is_zero _ a _ (by linarith)) _ _,
        is_zero.eq_of_src
          (by simpa only [double.is_zero_homology₂_iff] using hw.epi_g) _ _⟩⟩, }, },
end

lemma from_double_ext {K L : cochain_complex C ℤ} [K.is_strictly_le b] [K.is_strictly_ge a]
  (f₁ f₂ : K ⟶ L) (h₁ : f₁.f a = f₂.f a) (h₂ : f₁.f b = f₂.f b) : f₁ = f₂ :=
begin
  ext n,
  rcases double.four_cases h n with h' | (h' | h'),
  { apply is_zero.eq_of_src,
    cases h',
    { exact is_strictly_ge.is_zero _ a _ h', },
    { exact is_strictly_le.is_zero _ b _ h', }, },
  { unfreezingI { subst h', },
    exact h₁, },
  { unfreezingI { subst h', },
    exact h₂, },
end

omit h
variable (φ)

instance mapping_cone_single_map_is_strictly_le :
  (mapping_cone ((homological_complex.single _ _ 0).map φ)).is_strictly_le 0 :=
⟨λ n hn, begin
  rw mapping_cone.X_is_zero_iff,
  split; exact is_strictly_le.is_zero _ 0 _ (by linarith),
end⟩

instance mapping_cone_single_map_is_strictly_ge :
  (mapping_cone ((homological_complex.single _ _ 0).map φ)).is_strictly_ge (-1) :=
⟨λ n hn, begin
  rw mapping_cone.X_is_zero_iff,
  split; exact is_strictly_ge.is_zero _ 0 _ (by linarith),
end⟩

@[simps]
def double_iso_mapping_cone : double (neg_add_self 1) φ ≅
  mapping_cone ((homological_complex.single _ _ 0).map φ) :=
{ hom := double.desc (neg_add_self 1) φ _
      ((homological_complex.single_obj_X_self _ _ 0 A).inv ≫
        (mapping_cone.inl _).v _ _ (zero_add (-1)).symm)
      ((homological_complex.single_obj_X_self _ _ 0 B).inv ≫
        (mapping_cone.inr ((homological_complex.single _ _ 0).map φ)).f 0)
      begin
        simp only [assoc],
        erw mapping_cone.inl_d _ (-1) 0 1 (by linarith) (by linarith),
        simp only [homological_complex.single_obj_X_self_inv, eq_to_hom_refl,
          homological_complex.single_map_f_self, homological_complex.single_obj_X_self_hom,
          comp_id, assoc, homological_complex.single_obj_d, zero_comp, sub_zero, id_comp],
        erw id_comp,
      end
      (zero_add 1) (is_zero.eq_of_tgt
      (by simp only [mapping_cone.X_is_zero_iff, homological_complex.single_obj_X,
        add_self_eq_zero, one_ne_zero, if_false, and_self, is_zero_zero]) _ _),
  inv := double.lift (neg_add_self 1) φ _
      ((mapping_cone.fst _).1.v (-1) 0 (neg_add_self 1).symm ≫
          (homological_complex.single_obj_X_self _ _ 0 A).hom)
      ((mapping_cone.snd _ ).v _ _ (zero_add 0).symm ≫
        (homological_complex.single_obj_X_self _ _ 0 B).hom)
      begin
        rw mapping_cone.from_ext_iff _ _ _ (neg_add_self 1).symm,
        split,
        { simp only [assoc],
          erw mapping_cone.inl_fst_assoc,
          simp only [mapping_cone.inl_d_assoc _ (-1) 0 1 (by linarith) (by linarith),
            preadditive.sub_comp, assoc],
          erw [mapping_cone.inl_snd_assoc, mapping_cone.inr_snd_assoc],
          dsimp,
          simp [zero_comp, zero_comp, sub_zero], },
        { simp only [assoc, mapping_cone.inr_d_assoc _ (-1) 0],
          erw [mapping_cone.inr_fst_assoc, mapping_cone.inr_snd_assoc],
          simp only [homological_complex.single_obj_d, zero_comp], },
      end
      (show (-2 : ℤ) +1 = -1, by linarith)
      (is_zero.eq_of_src begin
        rw mapping_cone.X_is_zero_iff,
        split; exact is_strictly_ge.is_zero _ 0 _ (by linarith),
      end _ _),
  hom_inv_id' := begin
    refine from_double_ext (neg_add_self 1) _ _ _ _,
    { simp only [assoc, homological_complex.single_obj_X_self_inv, eq_to_hom_refl,
        homological_complex.single_obj_X_self_hom, id_comp, subtype.val_eq_coe,
        homological_complex.comp_f, double.desc_f, double.desc.f₁, double.lift_f,
        double.lift.f₁, homological_complex.id_f],
      erw mapping_cone.inl_fst_assoc,
      dsimp,
      simp only [id_comp, iso.hom_inv_id], },
    { simp only [assoc, homological_complex.single_obj_X_self_inv, eq_to_hom_refl,
        homological_complex.single_obj_X_self_hom, id_comp, homological_complex.comp_f,
        double.desc_f, double.desc.f₂, double.lift_f, double.lift.f₂,
        homological_complex.id_f],
      erw mapping_cone.inr_snd_assoc,
      dsimp,
      simp only [id_comp, iso.hom_inv_id], },
  end,
  inv_hom_id' := begin
    refine from_double_ext (neg_add_self 1) _ _ _ _,
    { simp only [assoc, id_comp, homological_complex.single_obj_X_self_inv, eq_to_hom_refl,
        homological_complex.single_obj_X_self_hom, subtype.val_eq_coe,
        homological_complex.comp_f, double.lift_f, double.lift.f₁, double.desc_f,
        double.desc.f₁, iso.inv_hom_id_assoc, homological_complex.id_f,
        mapping_cone.from_ext_iff _ _ _ (neg_add_self 1).symm,
        mapping_cone.inl_fst_assoc, mapping_cone.inr_fst_assoc, comp_id],
      split,
      { apply id_comp, },
      { apply is_zero.eq_of_src,
        exact is_strictly_ge.is_zero _ 0 _ (by linarith), }, },
    { simp only [assoc, id_comp, homological_complex.single_obj_X_self_inv, eq_to_hom_refl,
        homological_complex.single_obj_X_self_hom, homological_complex.comp_f, double.lift_f,
        double.lift.f₂, double.desc_f, double.desc.f₂, iso.inv_hom_id_assoc,
        homological_complex.id_f],
      erw id_comp,
      erw mapping_cone.to_ext_iff _ _ _ (zero_add 1).symm,
      simp only [assoc, mapping_cone.inr_fst, mapping_cone.inr_snd, id_comp, comp_id],
      split,
      { apply is_zero.eq_of_tgt,
        exact is_strictly_le.is_zero _ 0 _ (by { dsimp, linarith, }), },
      { refl, }, },
  end, }

end abelian

end cochain_complex


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.list.basic
import Mathlib.Lean3Lib.init.data.char.basic

universes l u_1

namespace Mathlib

/- In the VM, strings are implemented using a dynamic array and UTF-8 encoding.

   TODO: we currently cannot mark string_imp as private because
   we need to bind string_imp.mk and string_imp.cases_on in the VM.
-/

structure string_imp where
  data : List char

def string := string_imp

def list.as_string (s : List char) : string := string_imp.mk s

namespace string

protected instance has_lt : HasLess string :=
  { Less := fun (s₁ s₂ : string) => string_imp.data s₁ < string_imp.data s₂ }

/- Remark: this function has a VM builtin efficient implementation. -/

protected instance has_decidable_lt (s₁ : string) (s₂ : string) : Decidable (s₁ < s₂) :=
  list.has_decidable_lt (string_imp.data s₁) (string_imp.data s₂)

protected instance has_decidable_eq : DecidableEq string := fun (_x : string) => sorry

def empty : string := string_imp.mk []

def length : string → ℕ := sorry

/- The internal implementation uses dynamic arrays and will perform destructive updates
   if the string is not shared. -/

def push : string → char → string := sorry

/- The internal implementation uses dynamic arrays and will perform destructive updates
   if the string is not shared. -/

def append : string → string → string := sorry

/- O(n) in the VM, where n is the length of the string -/

def to_list : string → List char := sorry

def fold {α : Type u_1} (a : α) (f : α → char → α) (s : string) : α := list.foldl f a (to_list s)

/- In the VM, the string iterator is implemented as a pointer to the string being iterated + index.

   TODO: we currently cannot mark interator_imp as private because
   we need to bind string_imp.mk and string_imp.cases_on in the VM.
-/

structure iterator_imp where
  fst : List char
  snd : List char

def iterator := iterator_imp

def mk_iterator : string → iterator := sorry

namespace iterator

def curr : iterator → char := sorry

/- In the VM, `set_curr` is constant time if the string being iterated is not shared and linear time
   if it is. -/

def set_curr : iterator → char → iterator := sorry

def next : iterator → iterator := sorry

def prev : iterator → iterator := sorry

def has_next : iterator → Bool := sorry

def has_prev : iterator → Bool := sorry

def insert : iterator → string → iterator := sorry

def remove : iterator → ℕ → iterator := sorry

/- In the VM, `to_string` is a constant time operation. -/

def to_string : iterator → string := sorry

def to_end : iterator → iterator := sorry

def next_to_string : iterator → string := sorry

def prev_to_string : iterator → string := sorry

protected def extract_core : List char → List char → Option (List char) := sorry

def extract : iterator → iterator → Option string := sorry

end iterator

end string

/- The following definitions do not have builtin support in the VM -/

protected instance string.inhabited : Inhabited string := { default := string.empty }

protected instance string.has_sizeof : SizeOf string := { sizeOf := string.length }

protected instance string.has_append : Append string := { append := string.append }

namespace string

def str : string → char → string := push

def is_empty (s : string) : Bool := to_bool (length s = 0)

def front (s : string) : char := iterator.curr (mk_iterator s)

def back (s : string) : char := iterator.curr (iterator.prev (iterator.to_end (mk_iterator s)))

def join (l : List string) : string := list.foldl (fun (r s : string) => r ++ s) empty l

def singleton (c : char) : string := push empty c

def intercalate (s : string) (ss : List string) : string :=
  list.as_string (list.intercalate (to_list s) (list.map to_list ss))

namespace iterator

def nextn : iterator → ℕ → iterator := sorry

def prevn : iterator → ℕ → iterator := sorry

end iterator

def pop_back (s : string) : string :=
  iterator.prev_to_string (iterator.prev (iterator.to_end (mk_iterator s)))

def popn_back (s : string) (n : ℕ) : string :=
  iterator.prev_to_string (iterator.prevn (iterator.to_end (mk_iterator s)) n)

def backn (s : string) (n : ℕ) : string :=
  iterator.next_to_string (iterator.prevn (iterator.to_end (mk_iterator s)) n)

end string

protected def char.to_string (c : char) : string := string.singleton c

def string.to_nat (s : string) : ℕ := to_nat_core (string.mk_iterator s) (string.length s) 0

namespace string

theorem empty_ne_str (c : char) (s : string) : empty ≠ str s c := sorry

theorem str_ne_empty (c : char) (s : string) : str s c ≠ empty := ne.symm (empty_ne_str c s)

theorem str_ne_str_left {c₁ : char} {c₂ : char} (s₁ : string) (s₂ : string) :
    c₁ ≠ c₂ → str s₁ c₁ ≠ str s₂ c₂ :=
  sorry

theorem str_ne_str_right (c₁ : char) (c₂ : char) {s₁ : string} {s₂ : string} :
    s₁ ≠ s₂ → str s₁ c₁ ≠ str s₂ c₂ :=
  sorry

end Mathlib


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

! This file was ported from Lean 3 source module tactic.monotonicity.interactive
! leanprover-community/mathlib commit 69be6fe368f5617a607ebb6b356a7a71419cede3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Traversable.Derive
import Mathbin.Control.Traversable.Lemmas
import Leanbin.Data.Dlist
import Mathbin.Tactic.Monotonicity.Basic

variable {a b c p : Prop}

namespace Tactic.Interactive

open Lean Lean.Parser Interactive

open Interactive.Types

open Tactic

-- mathport name: parser.optional
local postfix:1024 "?" => optional

-- mathport name: parser.many
local postfix:1024 "*" => many

unsafe inductive mono_function (elab : Bool := true)
  | non_assoc : expr elab → List (expr elab) → List (expr elab) → mono_function
  | assoc : expr elab → Option (expr elab) → Option (expr elab) → mono_function
  | assoc_comm : expr elab → expr elab → mono_function
#align tactic.interactive.mono_function tactic.interactive.mono_function

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic tactic.mk_dec_eq_instance -/
unsafe instance : DecidableEq mono_function := by
  run_tac
    mk_dec_eq_instance

unsafe def mono_function.to_tactic_format : mono_function → tactic format
  | mono_function.non_assoc fn xs ys => do
    let fn' ← pp fn
    let xs' ← mapM pp xs
    let ys' ← mapM pp ys
    return f! "{fn' } {xs' } _ {ys'}"
  | mono_function.assoc fn xs ys => do
    let fn' ← pp fn
    let xs' ← pp xs
    let ys' ← pp ys
    return f! "{fn' } {xs' } _ {ys'}"
  | mono_function.assoc_comm fn xs => do
    let fn' ← pp fn
    let xs' ← pp xs
    return f! "{fn' } _ {xs'}"
#align tactic.interactive.mono_function.to_tactic_format tactic.interactive.mono_function.to_tactic_format

unsafe instance has_to_tactic_format_mono_function : has_to_tactic_format mono_function
    where to_tactic_format := mono_function.to_tactic_format
#align tactic.interactive.has_to_tactic_format_mono_function tactic.interactive.has_to_tactic_format_mono_function

unsafe structure ac_mono_ctx' (rel : Type) where
  to_rel : Rel
  function : mono_function
  (left right rel_def : expr)
  deriving Traversable
#align tactic.interactive.ac_mono_ctx' tactic.interactive.ac_mono_ctx'

@[reducible]
unsafe def ac_mono_ctx :=
  ac_mono_ctx' (Option (expr → expr → expr))
#align tactic.interactive.ac_mono_ctx tactic.interactive.ac_mono_ctx

@[reducible]
unsafe def ac_mono_ctx_ne :=
  ac_mono_ctx' (expr → expr → expr)
#align tactic.interactive.ac_mono_ctx_ne tactic.interactive.ac_mono_ctx_ne

unsafe def ac_mono_ctx.to_tactic_format (ctx : ac_mono_ctx) : tactic format := do
  let fn ← pp ctx.function
  let l ← pp ctx.left
  let r ← pp ctx.right
  let rel ← pp ctx.rel_def
  return
      f! "\{ function := {fn }
        , left  := {l }
        , right := {r }
        , rel_def := {Rel} }}"
#align tactic.interactive.ac_mono_ctx.to_tactic_format tactic.interactive.ac_mono_ctx.to_tactic_format

unsafe instance has_to_tactic_format_mono_ctx : has_to_tactic_format ac_mono_ctx
    where to_tactic_format := ac_mono_ctx.to_tactic_format
#align tactic.interactive.has_to_tactic_format_mono_ctx tactic.interactive.has_to_tactic_format_mono_ctx

unsafe def as_goal (e : expr) (tac : tactic Unit) : tactic Unit := do
  let gs ← get_goals
  set_goals [e]
  tac
  set_goals gs
#align tactic.interactive.as_goal tactic.interactive.as_goal

open List hiding map

open Functor Dlist

section Config

parameter (opt : MonoCfg)

parameter (asms : List expr)

unsafe def unify_with_instance (e : expr) : tactic Unit :=
  as_goal e <|
    apply_instance <|>
      apply_opt_param <|>
        apply_auto_param <|>
          tactic.solve_by_elim { lemmas := some asms } <|>
            reflexivity <|> applyc `` id <|> return ()
#align tactic.interactive.unify_with_instance tactic.interactive.unify_with_instance

private unsafe def match_rule_head (p : expr) : List expr → expr → expr → tactic expr
  | vs, e, t =>
    (unify t p >> mapM' unify_with_instance vs.reverse) >> instantiate_mvars e <|> do
      let expr.pi _ _ d b ← return t |
        failed
      let v ← mk_meta_var d
      match_rule_head (v :: vs) (expr.app e v) (b v)
#align tactic.interactive.match_rule_head tactic.interactive.match_rule_head

unsafe def pi_head : expr → tactic expr
  | expr.pi n _ t b => do
    let v ← mk_meta_var t
    pi_head (b v)
  | e => return e
#align tactic.interactive.pi_head tactic.interactive.pi_head

unsafe def delete_expr (e : expr) : List expr → tactic (Option (List expr))
  | [] => return none
  | x :: xs => compare opt e x >> return (some xs) <|> map (cons x) <$> delete_expr xs
#align tactic.interactive.delete_expr tactic.interactive.delete_expr

unsafe def match_ac' : List expr → List expr → tactic (List expr × List expr × List expr)
  | es, x :: xs => do
    let es' ← delete_expr x es
    match es' with
      | some es' => do
        let (c, l, r) ← match_ac' es' xs
        return (x :: c, l, r)
      | none => do
        let (c, l, r) ← match_ac' es xs
        return (c, l, x :: r)
  | es, [] => do
    return ([], es, [])
#align tactic.interactive.match_ac' tactic.interactive.match_ac'

unsafe def match_ac (l : List expr) (r : List expr) : tactic (List expr × List expr × List expr) :=
  do
  let (s', l', r') ← match_ac' l r
  let s' ← mapM instantiate_mvars s'
  let l' ← mapM instantiate_mvars l'
  let r' ← mapM instantiate_mvars r'
  return (s', l', r')
#align tactic.interactive.match_ac tactic.interactive.match_ac

unsafe def match_prefix : List expr → List expr → tactic (List expr × List expr × List expr)
  | x :: xs, y :: ys =>
    (do
        compare opt x y
        Prod.map ((· :: ·) x) id <$> match_prefix xs ys) <|>
      return ([], x :: xs, y :: ys)
  | xs, ys => return ([], xs, ys)
#align tactic.interactive.match_prefix tactic.interactive.match_prefix

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

unsafe def check_ac : expr → tactic (Bool × Bool × Option (expr × expr × expr) × expr)
  | expr.app (expr.app f x) y => do
    let t ← infer_type x
    let a ← try_core <| to_expr ``(IsAssociative $(t) $(f)) >>= mk_instance
    let c ← try_core <| to_expr ``(IsCommutative $(t) $(f)) >>= mk_instance
    let i ←
      try_core do
          let v ← mk_meta_var t
          let l_inst_p ← to_expr ``(IsLeftId $(t) $(f) $(v))
          let r_inst_p ← to_expr ``(IsRightId $(t) $(f) $(v))
          let l_v ← mk_meta_var l_inst_p
          let r_v ← mk_meta_var r_inst_p
          let l_id ← mk_mapp `is_left_id.left_id [some t, f, v, some l_v]
          mk_instance l_inst_p >>= unify l_v
          let r_id ← mk_mapp `is_right_id.right_id [none, f, v, some r_v]
          mk_instance r_inst_p >>= unify r_v
          let v' ← instantiate_mvars v
          return (l_id, r_id, v')
    return (a, c, i, f)
  | _ => return (false, false, none, expr.var 1)
#align tactic.interactive.check_ac tactic.interactive.check_ac

unsafe def parse_assoc_chain' (f : expr) : expr → tactic (Dlist expr)
  | e =>
    (do
        let expr.app (expr.app f' x) y ← return e
        is_def_eq f f'
        (· ++ ·) <$> parse_assoc_chain' x <*> parse_assoc_chain' y) <|>
      return (singleton e)
#align tactic.interactive.parse_assoc_chain' tactic.interactive.parse_assoc_chain'

unsafe def parse_assoc_chain (f : expr) : expr → tactic (List expr) :=
  map Dlist.toList ∘ parse_assoc_chain' f
#align tactic.interactive.parse_assoc_chain tactic.interactive.parse_assoc_chain

unsafe def fold_assoc (op : expr) :
    Option (expr × expr × expr) → List expr → Option (expr × List expr)
  | _, x :: xs => some (foldl (expr.app ∘ expr.app op) x xs, [])
  | none, [] => none
  | some (l_id, r_id, x₀), [] => some (x₀, [l_id, r_id])
#align tactic.interactive.fold_assoc tactic.interactive.fold_assoc

unsafe def fold_assoc1 (op : expr) : List expr → Option expr
  | x :: xs => some <| foldl (expr.app ∘ expr.app op) x xs
  | [] => none
#align tactic.interactive.fold_assoc1 tactic.interactive.fold_assoc1

unsafe def same_function_aux :
    List expr → List expr → expr → expr → tactic (expr × List expr × List expr)
  | xs₀, xs₁, expr.app f₀ a₀, expr.app f₁ a₁ => same_function_aux (a₀ :: xs₀) (a₁ :: xs₁) f₀ f₁
  | xs₀, xs₁, e₀, e₁ => is_def_eq e₀ e₁ >> return (e₀, xs₀, xs₁)
#align tactic.interactive.same_function_aux tactic.interactive.same_function_aux

unsafe def same_function : expr → expr → tactic (expr × List expr × List expr) :=
  same_function_aux [] []
#align tactic.interactive.same_function tactic.interactive.same_function

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

unsafe def parse_ac_mono_function' (l r : pexpr) := do
  let l' ← to_expr l
  let r' ← to_expr r
  parse_ac_mono_function l' r'
#align tactic.interactive.parse_ac_mono_function' tactic.interactive.parse_ac_mono_function'

-- failed to format: unknown constant 'term.pseudo.antiquot'
unsafe
  def
    ac_monotonicity_goal
    : expr → tactic ( expr × expr × List expr × ac_mono_ctx )
    |
        q( $ ( e₀ ) → $ ( e₁ ) )
        =>
        do
          let ( l , r , id_rs , f ) ← parse_ac_mono_function e₀ e₁
            let t₀ ← infer_type e₀
            let t₁ ← infer_type e₁
            let rel_def ← to_expr ` `( fun x₀ x₁ => ( x₀ : $ ( t₀ ) ) → ( x₁ : $ ( t₁ ) ) )
            return
              (
                e₀
                  ,
                  e₁
                    ,
                    id_rs
                    ,
                    {
                      function := f
                        left := l
                        right := r
                        to_rel := some <| expr.pi `x BinderInfo.default
                        rel_def
                      }
                )
      |
        q( $ ( e₀ ) = $ ( e₁ ) )
        =>
        do
          let ( l , r , id_rs , f ) ← parse_ac_mono_function e₀ e₁
            let t₀ ← infer_type e₀
            let t₁ ← infer_type e₁
            let rel_def ← to_expr ` `( fun x₀ x₁ => ( x₀ : $ ( t₀ ) ) = ( x₁ : $ ( t₁ ) ) )
            return
              ( e₀ , e₁ , id_rs , { function := f left := l right := r to_rel := none rel_def } )
      |
        expr.app ( expr.app Rel e₀ ) e₁
        =>
        do
          let ( l , r , id_rs , f ) ← parse_ac_mono_function e₀ e₁
            return
              (
                e₀
                  ,
                  e₁
                    ,
                    id_rs
                    ,
                    {
                      function := f
                        left := l
                        right := r
                        to_rel := expr.app ∘ expr.app Rel
                        rel_def := Rel
                      }
                )
      | _ => fail "invalid monotonicity goal"
#align tactic.interactive.ac_monotonicity_goal tactic.interactive.ac_monotonicity_goal

unsafe def bin_op_left (f : expr) : Option expr → expr → expr
  | none, e => e
  | some e₀, e₁ => f.mk_app [e₀, e₁]
#align tactic.interactive.bin_op_left tactic.interactive.bin_op_left

unsafe def bin_op (f a b : expr) : expr :=
  f.mk_app [a, b]
#align tactic.interactive.bin_op tactic.interactive.bin_op

unsafe def bin_op_right (f : expr) : expr → Option expr → expr
  | e, none => e
  | e₀, some e₁ => f.mk_app [e₀, e₁]
#align tactic.interactive.bin_op_right tactic.interactive.bin_op_right

unsafe def mk_fun_app : mono_function → expr → expr
  | mono_function.non_assoc f x y, z => f.mk_app (x ++ z :: y)
  | mono_function.assoc f x y, z => bin_op_left f x (bin_op_right f z y)
  | mono_function.assoc_comm f x, z => f.mk_app [z, x]
#align tactic.interactive.mk_fun_app tactic.interactive.mk_fun_app

unsafe inductive mono_law/- `assoc (l₀,r₀) (r₁,l₁)` gives first how to find rules to prove
      x+(y₀+z) R x+(y₁+z);
      if that fails, helps prove (x+y₀)+z R (x+y₁)+z -/

  |
  assoc :
    expr × expr → expr × expr → mono_law-- `congr r` gives the rule to prove `x = y → f x = f y`

  | congr : expr → mono_law
  | other : expr → mono_law
#align tactic.interactive.mono_law tactic.interactive.mono_law

unsafe def mono_law.to_tactic_format : mono_law → tactic format
  | mono_law.other e => do
    let e ← pp e
    return f! "other {e}"
  | mono_law.congr r => do
    let e ← pp r
    return f! "congr {e}"
  | mono_law.assoc (x₀, x₁) (y₀, y₁) => do
    let x₀ ← pp x₀
    let x₁ ← pp x₁
    let y₀ ← pp y₀
    let y₁ ← pp y₁
    return f! "assoc {x₀ }; {x₁ } | {y₀ }; {y₁}"
#align tactic.interactive.mono_law.to_tactic_format tactic.interactive.mono_law.to_tactic_format

unsafe instance has_to_tactic_format_mono_law : has_to_tactic_format mono_law
    where to_tactic_format := mono_law.to_tactic_format
#align tactic.interactive.has_to_tactic_format_mono_law tactic.interactive.has_to_tactic_format_mono_law

unsafe def mk_rel (ctx : ac_mono_ctx_ne) (f : expr → expr) : expr :=
  ctx.to_rel (f ctx.left) (f ctx.right)
#align tactic.interactive.mk_rel tactic.interactive.mk_rel

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `xs₁ -/
unsafe def mk_congr_args (fn : expr) (xs₀ xs₁ : List expr) (l r : expr) : tactic expr := do
  let p ← mk_app `eq [fn.mk_app <| xs₀ ++ l :: xs₁, fn.mk_app <| xs₀ ++ r :: xs₁]
  Prod.snd <$>
      solve_aux p do
        iterate_exactly (xs₁ xs₁.length) (applyc `congr_fun)
        applyc `congr_arg
#align tactic.interactive.mk_congr_args tactic.interactive.mk_congr_args

unsafe def mk_congr_law (ctx : ac_mono_ctx) : tactic expr :=
  match ctx.function with
  | mono_function.assoc f x₀ x₁ =>
    if (x₀ <|> x₁).isSome then mk_congr_args f x₀.toMonad x₁.toMonad ctx.left ctx.right else failed
  | mono_function.assoc_comm f x₀ => mk_congr_args f [x₀] [] ctx.left ctx.right
  | mono_function.non_assoc f x₀ x₁ => mk_congr_args f x₀ x₁ ctx.left ctx.right
#align tactic.interactive.mk_congr_law tactic.interactive.mk_congr_law

unsafe def mk_pattern (ctx : ac_mono_ctx) : tactic mono_law :=
  match (sequence ctx : Option (ac_mono_ctx' _)) with
  | some ctx =>
    match ctx.function with
    | mono_function.assoc f (some x) (some y) =>
      return <|
        mono_law.assoc
          (mk_rel ctx fun i => bin_op f x (bin_op f i y), mk_rel ctx fun i => bin_op f i y)
          (mk_rel ctx fun i => bin_op f (bin_op f x i) y, mk_rel ctx fun i => bin_op f x i)
    | mono_function.assoc f (some x) none =>
      return <| mono_law.other <| mk_rel ctx fun e => mk_fun_app ctx.function e
    | mono_function.assoc f none (some y) =>
      return <| mono_law.other <| mk_rel ctx fun e => mk_fun_app ctx.function e
    | mono_function.assoc f none none => none
    | _ => return <| mono_law.other <| mk_rel ctx fun e => mk_fun_app ctx.function e
  | none => mono_law.congr <$> mk_congr_law ctx
#align tactic.interactive.mk_pattern tactic.interactive.mk_pattern

unsafe def match_rule (pat : expr) (r : Name) : tactic expr := do
  let r' ← mk_const r
  let t ← infer_type r'
  let t ←
    expr.dsimp t { failIfUnchanged := false } true []
        [simp_arg_type.expr ``(Monotone), simp_arg_type.expr ``(StrictMono)]
  match_rule_head pat [] r' t
#align tactic.interactive.match_rule tactic.interactive.match_rule

unsafe def find_lemma (pat : expr) : List Name → tactic (List expr)
  | [] => return []
  | r :: rs => do
    (cons <$> match_rule pat r <|> pure id) <*> find_lemma rs
#align tactic.interactive.find_lemma tactic.interactive.find_lemma

-- failed to format: unknown constant 'term.pseudo.antiquot'
unsafe
  def
    match_chaining_rules
    ( ls : List Name ) ( x₀ x₁ : expr ) : tactic ( List expr )
    :=
      do
        let x' ← to_expr ` `( $ ( x₁ ) → $ ( x₀ ) )
          let r₀ ← find_lemma x' ls
          let r₁ ← find_lemma x₁ ls
          return ( expr.app <$> r₀ <*> r₁ )
#align tactic.interactive.match_chaining_rules tactic.interactive.match_chaining_rules

unsafe def find_rule (ls : List Name) : mono_law → tactic (List expr)
  | mono_law.assoc (x₀, x₁) (y₀, y₁) =>
    match_chaining_rules ls x₀ x₁ <|> match_chaining_rules ls y₀ y₁
  | mono_law.congr r => return [r]
  | mono_law.other p => find_lemma p ls
#align tactic.interactive.find_rule tactic.interactive.find_rule

universe u v

def applyRel {α : Sort u} (R : α → α → Sort v) {x y : α} (x' y' : α) (h : R x y) (hx : x = x')
    (hy : y = y') : R x' y' := by
  rw [← hx, ← hy]
  apply h
#align tactic.interactive.apply_rel Tactic.Interactive.applyRel

unsafe def ac_refine (e : expr) : tactic Unit :=
  andthen (refine ``(Eq.mp _ $(e))) ac_refl
#align tactic.interactive.ac_refine tactic.interactive.ac_refine

unsafe def one_line (e : expr) : tactic format := do
  let lbl ← pp e
  let asm ← infer_type e >>= pp
  return
      f! "	{asm}
        "
#align tactic.interactive.one_line tactic.interactive.one_line

unsafe def side_conditions (e : expr) : tactic format := do
  let vs := e.list_meta_vars
  let ts ← mapM one_line vs.tail
  let r := e.get_app_fn.const_name
  return
      f! "{r }:
        {format.join ts}"
#align tactic.interactive.side_conditions tactic.interactive.side_conditions

open Monad

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      tactic-facing function, similar to `interactive.tactic.generalize` with the
      exception that meta variables -/
    private
    unsafe
  def
    monotonicity.generalize'
    ( h : Name ) ( v : expr ) ( x : Name ) : tactic ( expr × expr )
    :=
      do
        let tgt ← target
          let t ← infer_type v
          let
            tgt'
              ←
              (
                  do
                    let ⟨ tgt' , _ ⟩ ← solve_aux tgt ( tactic.generalize v x >> target )
                      to_expr ` `( fun y : $ ( t ) => ∀ x , y = x → $ ( tgt' 0 1 ) )
                  )
                <|>
                to_expr ` `( fun y : $ ( t ) => ∀ x , $ ( v ) = x → $ ( tgt ) )
          let t ← head_beta ( tgt' v ) >>= assert h
          swap
          let r ← mk_eq_refl v
          solve1 <| tactic.exact ( t v r )
          Prod.mk <$> tactic.intro x <*> tactic.intro h
#align tactic.interactive.monotonicity.generalize' tactic.interactive.monotonicity.generalize'

private unsafe def hide_meta_vars (tac : List expr → tactic Unit) : tactic Unit :=
  focus1 do
    let tgt ← target >>= instantiate_mvars
    tactic.change tgt
    let ctx ← local_context
    let vs := tgt.list_meta_vars
    let vs' ←
      mapM
          (fun v => do
            let h ← get_unused_name `h
            let x ← get_unused_name `x
            Prod.snd <$> monotonicity.generalize' h v x)
          vs
    andthen (tac ctx) (vs' (try ∘ tactic.subst))
#align tactic.interactive.hide_meta_vars tactic.interactive.hide_meta_vars

unsafe def hide_meta_vars' (tac : itactic) : itactic :=
  hide_meta_vars fun _ => tac
#align tactic.interactive.hide_meta_vars' tactic.interactive.hide_meta_vars'

end Config

unsafe def solve_mvar (v : expr) (tac : tactic Unit) : tactic Unit := do
  let gs ← get_goals
  set_goals [v]
  target >>= instantiate_mvars >>= tactic.change
  tac
  done
  set_goals <| gs
#align tactic.interactive.solve_mvar tactic.interactive.solve_mvar

def List.minimumOn {α β} [LinearOrder β] (f : α → β) : List α → List α
  | [] => []
  | x :: xs =>
    Prod.snd <|
      xs.foldl
        (fun ⟨k, a⟩ b =>
          let k' := f b
          if k < k' then (k, a) else if k' < k then (k', [b]) else (k, b :: a))
        (f x, [x])
#align tactic.interactive.list.minimum_on Tactic.Interactive.List.minimumOn

open Format MonoSelection

unsafe def best_match {β} (xs : List expr) (tac : expr → tactic β) : tactic Unit := do
  let t ← target
  let xs ← xs.mapM fun x => try_core <| Prod.mk x <$> solve_aux t (tac x >> get_goals)
  let xs := xs.filterMap id
  let r := List.minimumOn (List.length ∘ Prod.fst ∘ Prod.snd) xs
  match r with
    | [(_, gs, pr)] => tactic.exact pr >> set_goals gs
    | [] => fail "no good match found"
    | _ => do
      let lmms ←
        r fun ⟨l, gs, _⟩ => do
            let ts ← gs infer_type
            let msg ← ts pp
            pure <| foldl compose "\n\n" <| List.intersperse "\n" <| to_fmt l :: msg
      let msg := foldl compose "" lmms
      fail
          f! "ambiguous match: {msg}

            Tip: try asserting a side condition to distinguish between the lemmas"
#align tactic.interactive.best_match tactic.interactive.best_match

unsafe def mono_aux (dir : parse side) : tactic Unit := do
  let t ← target >>= instantiate_mvars
  let ns ← get_monotonicity_lemmas t dir
  let asms ← local_context
  let rs ← find_lemma asms t ns
  focus1 <| () <$ best_match rs fun law => tactic.refine <| to_pexpr law
#align tactic.interactive.mono_aux tactic.interactive.mono_aux

/-- - `mono` applies a monotonicity rule.
- `mono*` applies monotonicity rules repetitively.
- `mono with x ≤ y` or `mono with [0 ≤ x,0 ≤ y]` creates an assertion for the listed
  propositions. Those help to select the right monotonicity rule.
- `mono left` or `mono right` is useful when proving strict orderings:
   for `x + y < w + z` could be broken down into either
    - left:  `x ≤ w` and `y < z` or
    - right: `x < w` and `y ≤ z`
- `mono using [rule1,rule2]` calls `simp [rule1,rule2]` before applying mono.
- The general syntax is
  `mono '*'? ('with' hyp | 'with' [hyp1,hyp2])? ('using' [hyp1,hyp2])? mono_cfg?`

To use it, first import `tactic.monotonicity`.

Here is an example of mono:

```lean
example (x y z k : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y) :
  (k + 3 + x) - y ≤ (k + 4 + x) - z :=
begin
  mono, -- unfold `(-)`, apply add_le_add
  { -- ⊢ k + 3 + x ≤ k + 4 + x
    mono, -- apply add_le_add, refl
    -- ⊢ k + 3 ≤ k + 4
    mono },
  { -- ⊢ -y ≤ -z
    mono /- apply neg_le_neg -/ }
end
```

More succinctly, we can prove the same goal as:

```lean
example (x y z k : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y) :
  (k + 3 + x) - y ≤ (k + 4 + x) - z :=
by mono*
```

-/
unsafe def mono (many : parse (tk "*")?) (dir : parse side)
    (hyps : parse <| tk "with" *> pexpr_list_or_texpr <|> pure [])
    (simp_rules : parse <| tk "using" *> simp_arg_list <|> pure []) : tactic Unit := do
  let hyps ← hyps.mapM fun p => to_expr p >>= mk_meta_var
  hyps fun pr => do
      let h ← get_unused_name `h
      note h none pr
  when (¬simp_rules) (simp_core { } failed tt simp_rules [] (loc.ns [none]) >> skip)
  if many then repeat <| mono_aux dir else mono_aux dir
  let gs ← get_goals
  set_goals <| hyps ++ gs
#align tactic.interactive.mono tactic.interactive.mono

add_tactic_doc
  { Name := "mono"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.mono]
    tags := ["monotonicity"] }

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `g -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- transforms a goal of the form `f x ≼ f y` into `x ≤ y` using lemmas
marked as `monotonic`.

Special care is taken when `f` is the repeated application of an
associative operator and if the operator is commutative
-/
unsafe def ac_mono_aux (cfg : MonoCfg := { }) : tactic Unit :=
  hide_meta_vars fun asms => do
    try sorry
    let tgt ← target >>= instantiate_mvars
    let (l, r, id_rs, g) ← ac_monotonicity_goal cfg tgt <|> fail "monotonic context not found"
    let ns ← get_monotonicity_lemmas tgt both
    let p ← mk_pattern g
    let rules ← find_rule asms ns p <|> fail "no applicable rules found"
    when (rules = []) (fail "no applicable rules found")
    let err ← format.join <$> mapM side_conditions rules
    focus1 <|
        best_match rules fun rule => do
          let t₀ ← mk_meta_var q(Prop)
          let v₀ ← mk_meta_var t₀
          let t₁ ← mk_meta_var q(Prop)
          let v₁ ← mk_meta_var t₁
          tactic.refine <| ``(applyRel (g $(g.rel_def)) $(l) $(r) $(rule) $(v₀) $(v₁))
          solve_mvar v₀ (try (any_of id_rs rewrite_target) >> (done <|> refl <|> ac_refl <|> sorry))
          solve_mvar v₁ (try (any_of id_rs rewrite_target) >> (done <|> refl <|> ac_refl <|> sorry))
          let n ← num_goals
          iterate_exactly (n - 1)
              (try <| solve1 <| apply_instance <|> tactic.solve_by_elim { lemmas := some asms })
#align tactic.interactive.ac_mono_aux tactic.interactive.ac_mono_aux

open Sum Nat

/-- (repeat_until_or_at_most n t u): repeat tactic `t` at most n times or until u succeeds -/
unsafe def repeat_until_or_at_most : Nat → tactic Unit → tactic Unit → tactic Unit
  | 0, t, _ => fail "too many applications"
  | succ n, t, u => u <|> t >> repeat_until_or_at_most n t u
#align tactic.interactive.repeat_until_or_at_most tactic.interactive.repeat_until_or_at_most

unsafe def repeat_until : tactic Unit → tactic Unit → tactic Unit :=
  repeat_until_or_at_most 100000
#align tactic.interactive.repeat_until tactic.interactive.repeat_until

inductive RepArity : Type
  | one
  | exactly (n : ℕ)
  | many
  deriving _root_.has_reflect, Inhabited
#align tactic.interactive.rep_arity Tactic.Interactive.RepArity

unsafe def repeat_or_not : RepArity → tactic Unit → Option (tactic Unit) → tactic Unit
  | rep_arity.one, tac, none => tac
  | rep_arity.many, tac, none => repeat tac
  | rep_arity.exactly n, tac, none => iterate_exactly' n tac
  | rep_arity.one, tac, some until => tac >> until
  | rep_arity.many, tac, some until => repeat_until tac until
  | rep_arity.exactly n, tac, some until => iterate_exactly n tac >> until
#align tactic.interactive.repeat_or_not tactic.interactive.repeat_or_not

unsafe def assert_or_rule : lean.parser (Sum pexpr pexpr) :=
  tk ":=" *> inl <$> texpr <|> tk ":" *> inr <$> texpr
#align tactic.interactive.assert_or_rule tactic.interactive.assert_or_rule

unsafe def arity : lean.parser RepArity :=
  tk "*" *> pure RepArity.many <|> RepArity.exactly <$> (tk "^" *> small_nat) <|> pure RepArity.one
#align tactic.interactive.arity tactic.interactive.arity

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

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

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

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

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

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

To use it, first import `tactic.monotonicity`.

`ac_mono` can be used as follows:

```lean
example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y) :
  (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  -- ⊢ (m + x + n) * z ≤ z * (y + n + m)
  ac_mono,
  -- ⊢ m + x + n ≤ y + n + m
  ac_mono,
end
```

As with `mono*`, `ac_mono*` solves the goal in one go and so does
`ac_mono* := h₁`. The latter syntax becomes especially interesting in the
following example:

```lean
example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : m + x + n ≤ y + n + m) :
  (m + x + n) * z + k ≤ z * (y + n + m) + k :=
by ac_mono* := h₁.
```

By giving `ac_mono` the assumption `h₁`, we are asking `ac_refl` to
stop earlier than it would normally would.
-/
unsafe def ac_mono (rep : parse arity) : parse assert_or_rule ? → optParam MonoCfg { } → tactic Unit
  | none, opt => focus1 <| repeat_or_not rep (ac_mono_aux opt) none
  | some (inl h), opt => do
    focus1 <| repeat_or_not rep (ac_mono_aux opt) (some <| done <|> to_expr h >>= ac_refine)
  | some (inr t), opt => do
    let h ← i_to_expr t >>= assert `h
    tactic.swap
    focus1 <| repeat_or_not rep (ac_mono_aux opt) (some <| done <|> ac_refine h)
#align tactic.interactive.ac_mono tactic.interactive.ac_mono

/-
TODO(Simon): with `ac_mono := h` and `ac_mono : p` split the remaining
  gaol if the provided rule does not solve it completely.
-/
add_tactic_doc
  { Name := "ac_mono"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.ac_mono]
    tags := ["monotonicity"] }

attribute [mono] And.imp Or.imp

end Tactic.Interactive


import category_theory.quotient
import category_theory.limits.shapes.zero_morphisms
import category_theory.preadditive.additive_functor
import group_theory.subgroup.basic

namespace category_theory

open limits

namespace quotient

variables {C D : Type*} [category C] [category D] {r : hom_rel C}

lemma functor_map_surjective (X Y : C) :
  function.surjective (λ (f : X ⟶ Y), (functor r).map f) := surjective_quot_mk _

lemma nat_trans_ext {F G : quotient r ⥤ D} (τ₁ τ₂ : F ⟶ G)
  (h : ∀ (X : C), τ₁.app ((functor r).obj X) = τ₂.app ((functor r).obj X)) : τ₁ = τ₂ :=
by { ext X, cases X, exact h X, }

def lift_nat_trans (F G : quotient r ⥤ D) (τ : functor _ ⋙ F ⟶ functor _ ⋙ G) :
  F ⟶ G :=
{ app := by { rintro ⟨X⟩, exact τ.app X, },
  naturality' := by { rintros ⟨X⟩ ⟨Y⟩ ⟨f⟩, exact τ.naturality f, }, }

@[simp]
lemma lift_nat_trans_app (F G : quotient r ⥤ D) (τ : functor _ ⋙ F ⟶ functor _ ⋙ G) (X : C) :
  (lift_nat_trans F G τ).app ((functor r).obj X) = τ.app X := rfl

@[simp]
lemma lift_nat_trans_id (F : quotient r ⥤ D) :
  lift_nat_trans F F (𝟙 _) = 𝟙 _ :=
nat_trans_ext _ _ (λ X, rfl)

@[simp, reassoc]
lemma lift_nat_trans_comp (F G H : quotient r ⥤ D) (τ : functor _ ⋙ F ⟶ functor _ ⋙ G)
  (τ' : functor _ ⋙ G ⟶ functor _ ⋙ H) :
  lift_nat_trans F G τ ≫ lift_nat_trans G H τ' = lift_nat_trans F H (τ ≫ τ') :=
nat_trans_ext _ _ (λ X, by simp)

@[simps]
def lift_nat_iso (F G : quotient r ⥤ D) (e : functor _ ⋙ F ≅ functor _ ⋙ G) :
  F ≅ G :=
{ hom := lift_nat_trans _ _ e.hom,
  inv := lift_nat_trans _ _ e.inv, }

variable (r)

def lift_nat_trans' {F G : C ⥤ D} (τ : F ⟶ G)
  (hF : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), F.map f₁ = F.map f₂)
  (hG : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), G.map f₁ = G.map f₂) :
  lift r F hF ⟶ lift r G hG :=
lift_nat_trans _ _
    ((quotient.lift.is_lift r F hF).hom ≫ τ ≫ (quotient.lift.is_lift r G hG).inv)

@[simp]
lemma lift_nat_trans'_app {F G : C ⥤ D} (τ : F ⟶ G)
  (hF : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), F.map f₁ = F.map f₂)
  (hG : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), G.map f₁ = G.map f₂) (X : C) :
  (lift_nat_trans' r τ hF hG).app ((functor r).obj X) = τ.app X :=
begin
  dsimp [lift_nat_trans'],
  simp,
end

@[simp]
lemma lift_nat_trans'_id (F : C ⥤ D)
  (hF : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), F.map f₁ = F.map f₂) :
  lift_nat_trans' r (𝟙 F) hF hF = 𝟙 _ :=
nat_trans_ext _ _ (λ X, by { dsimp, simp, })

@[simp]
lemma lift_nat_trans'_comp {F G H : C ⥤ D} (τ : F ⟶ G) (τ' : G ⟶ H)
  (hF : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), F.map f₁ = F.map f₂)
  (hG : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), G.map f₁ = G.map f₂)
  (hH : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), H.map f₁ = H.map f₂) :
  lift_nat_trans' r τ hF hG ≫ lift_nat_trans' r τ' hG hH =
    lift_nat_trans' r (τ ≫ τ') hF hH :=
nat_trans_ext _ _ (λ X, by simp)

@[simps]
def lift_nat_iso' {F G : C ⥤ D} (e : F ≅ G)
  (hF : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), F.map f₁ = F.map f₂)
  (hG : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), G.map f₁ = G.map f₂) :
  lift r F hF ≅ lift r G hG :=
{ hom := lift_nat_trans' r e.hom hF hG,
  inv := lift_nat_trans' r e.inv hG hF, }

lemma lift_map_eq (F : C ⥤ D)
  (hF : ∀ (X Y : C) (f₁ f₂ : X ⟶ Y) (h : r f₁ f₂), F.map f₁ = F.map f₂)
  {X Y : C} (f : X ⟶ Y) :
  (lift r F hF).map ((functor r).map f) = F.map f :=
by rw [functor_map, lift_map]

open_locale zero_object

lemma is_zero_of_is_zero {X : C} (hX : is_zero X) :
  is_zero ((functor r).obj X) :=
begin
  haveI : has_zero_object C := ⟨⟨_, hX⟩⟩,
  refine limits.is_zero.of_iso _ ((functor r).map_iso (is_zero.iso_zero hX)),
  split,
  { rintro ⟨Y⟩,
    haveI := (has_zero_object.unique_from Y),
    refine ⟨⟨⟨(functor r).map default⟩, _⟩⟩,
    intro f,
    obtain ⟨g, rfl⟩ := functor_map_surjective _ _ f,
    rw subsingleton.elim g default, },
  { rintro ⟨Y⟩,
    haveI := (has_zero_object.unique_to Y),
    refine ⟨⟨⟨(functor r).map default⟩, _⟩⟩,
    intro f,
    obtain ⟨g, rfl⟩ := functor_map_surjective _ _ f,
    rw subsingleton.elim g default, },
end

instance [has_zero_object C] : has_zero_object (quotient r) :=
⟨⟨_, is_zero_of_is_zero _ (is_zero_zero C)⟩⟩

section preadditive

variables [preadditive C] [congruence r]
  (add : ∀ ⦃X Y : C⦄ ⦃f₁ g₁ f₂ g₂ : X ⟶ Y⦄ (h₁ : r f₁ g₁) (h₂ : r f₂ g₂), (r (f₁ + f₂) (g₁ + g₂)))
  (neg : ∀ ⦃X Y : C⦄ ⦃f g : X ⟶ Y⦄ (h : r f g), r (-f) (-g))

lemma comp_closure_eq_self : comp_closure r = r :=
begin
  ext X Y f₁ f₂,
  split,
  { intro h,
    simpa only [← functor_map_eq_iff r] using quot.sound h, },
  { exact comp_closure.of _ _ _, },
end

variable {r}

include add

def preadditive.add {X Y : quotient r} (φ φ' : X ⟶ Y) : X ⟶ Y :=
begin
  refine quot.lift₂ (λ x y, quot.mk _ (x+y)) _ _ φ φ',
  { intros x y₁ y₂ h,
    rw comp_closure_eq_self at h,
    change (functor r).map (x+y₁) = (functor r).map (x+y₂),
    rw functor_map_eq_iff,
    exact add (refl _) h, },
  { intros x₁ x₂ y h,
    rw comp_closure_eq_self at h,
    change (functor r).map (x₁+y) = (functor r).map (x₂+y),
    rw functor_map_eq_iff,
    exact add h (refl _), },
end

omit add

include neg

def preadditive.neg {X Y : quotient r} (φ : X ⟶ Y) : X ⟶ Y :=
begin
  refine quot.lift (λ x, quot.mk _ (-x)) _ φ,
  intros x y h,
  rw comp_closure_eq_self at h,
  change (functor r).map (-x) = (functor r).map (-y),
  rw functor_map_eq_iff,
  exact neg h,
end

include add
variable (r)

def preadditive.hom_group (X Y : quotient r) : add_comm_group (X ⟶ Y) :=
{ add := preadditive.add add,
  add_assoc := by { rintros ⟨x⟩ ⟨y⟩ ⟨z⟩, exact (functor r).congr_map (add_assoc x y z), },
  zero := (functor r).map 0,
  zero_add := by { rintro ⟨x⟩, exact (functor r).congr_map (zero_add x), },
  add_zero := by { rintro ⟨x⟩, exact (functor r).congr_map (add_zero x), },
  neg := preadditive.neg neg,
  add_left_neg := by { rintro ⟨x⟩, exact (functor r).congr_map (add_left_neg x), },
  add_comm := by { rintros ⟨x⟩ ⟨y⟩, exact (functor r).congr_map (add_comm x y), }, }

@[protected]
def preadditive :
  preadditive (quotient r) :=
{ hom_group := preadditive.hom_group r add neg,
  add_comp' := λ X Y Z, begin
    rintros ⟨x₁⟩ ⟨x₂⟩ ⟨y⟩,
    exact (functor r).congr_map (preadditive.add_comp _ _ _ x₁ x₂ y),
  end,
  comp_add' := λ X Y Z, begin
    rintros ⟨x⟩ ⟨y₁⟩ ⟨y₂⟩,
    exact (functor r).congr_map (preadditive.comp_add _ _ _ x y₁ y₂),
  end, }

lemma functor_additive :
  @functor.additive C (quotient r) _ _ _ (quotient.preadditive r add neg) (functor r) := { }

omit add neg

lemma lift_additive {D : Type*} [category D] [preadditive D] [preadditive (quotient r)]
  [(functor r).additive] (F : C ⥤ D) [F.additive]
  (H : ∀ (x y : C) (f₁ f₂ : x ⟶ y), r f₁ f₂ → F.map f₁ = F.map f₂) :
  (lift r F H).additive :=
⟨begin
  rintro ⟨X⟩ ⟨Y⟩ ⟨f₁ : X ⟶ Y⟩ ⟨f₂ : X ⟶ Y⟩,
  change (lift r F H).map ((functor r).map f₁ + (functor r).map f₂) = F.map f₁ + F.map f₂,
  simpa only [← functor.map_add],
end⟩

end preadditive

end quotient

end category_theory


/-
Copyright (c) 2019 Paul-Nicolas Madelaine. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Paul-Nicolas Madelaine, Robert Y. Lewis

Normalizing casts inside expressions.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.converter.interactive
import Mathlib.tactic.hint
import Mathlib.PostPort

universes l u_1 u_2

namespace Mathlib

/-!
# A tactic for normalizing casts inside expressions

This tactic normalizes casts inside expressions.
It can be thought of as a call to the simplifier with a specific set of lemmas to
move casts upwards in the expression.
It has special handling of numerals and a simple heuristic to help moving
casts "past" binary operators.
Contrary to simp, it should be safe to use as a non-terminating tactic.

The algorithm implemented here is described in the paper
<https://lean-forward.github.io/norm_cast/norm_cast.pdf>.

## Important definitions
* `tactic.interactive.norm_cast`
* `tactic.interactive.push_cast`
* `tactic.interactive.exact_mod_cast`
* `tactic.interactive.apply_mod_cast`
* `tactic.interactive.rw_mod_cast`
* `tactic.interactive.assumption_mod_cast`
-/

namespace tactic

/--
Runs `mk_instance` with a time limit.

This is a work around to the fact that in some cases
mk_instance times out instead of failing,
for example: `has_lift_t ℤ ℕ`

`mk_instance_fast` is used when we assume the type class search
should end instantly.
-/
end tactic

namespace norm_cast

/--
Output a trace message if `trace.norm_cast` is enabled.
-/
/--
`label` is a type used to classify `norm_cast` lemmas.
* elim lemma:   LHS has 0 head coes and ≥ 1 internal coe
* move lemma:   LHS has 1 head coe and 0 internal coes,    RHS has 0 head coes and ≥ 1 internal coes
* squash lemma: LHS has ≥ 1 head coes and 0 internal coes, RHS has fewer head coes
-/
inductive label where
| elim : label
| move : label
| squash : label

namespace label

/-- Convert `label` into `string`. -/
protected def to_string : label → string := sorry

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

protected instance has_repr : has_repr label := has_repr.mk label.to_string

/-- Convert `string` into `label`. -/
def of_string : string → Option label := sorry

end label

/-- Count how many coercions are at the top of the expression. -/
/-- Count how many coercions are inside the expression, including the top ones. -/
/-- Count how many coercions are inside the expression, excluding the top ones. -/
/--
Classifies a declaration of type `ty` as a `norm_cast` rule.
-/
/-- The cache for `norm_cast` attribute stores three `simp_lemma` objects. -/
/-- Empty `norm_cast_cache`. -/
/-- `add_elim cache e` adds `e` as an `elim` lemma to `cache`. -/
/-- `add_move cache e` adds `e` as a `move` lemma to `cache`. -/
/-- `add_squash cache e` adds `e` as an `squash` lemma to `cache`. -/
/--
The type of the `norm_cast` attribute.
The optional label is used to overwrite the classifier.
-/
/--
Efficient getter for the `@[norm_cast]` attribute parameter that does not call `eval_expr`.

See Note [user attribute parameters].
-/
/--
`add_lemma cache decl` infers the proper `norm_cast` attribute for `decl` and adds it to `cache`.
-/
-- special lemmas to handle the ≥, > and ≠ operators

/--
`mk_cache names` creates a `norm_cast_cache`. It infers the proper `norm_cast` attributes
for names in `names`, and collects the lemmas attributed with specific `norm_cast` attributes.
-/
-- names has the declarations in reverse order

--some special lemmas to handle binary relations

/--
The `norm_cast` attribute.
-/
/-- Classify a declaration as a `norm_cast` rule. -/
/--
Gets the `norm_cast` classification label for a declaration. Applies the
override specified on the attribute, if necessary.
-/
end norm_cast

namespace tactic.interactive

/--
`push_cast` rewrites the expression to move casts toward the leaf nodes.
For example, `↑(a + b)` will be written to `↑a + ↑b`.
Equivalent to `simp only with push_cast`.
Can also be used at hypotheses.

`push_cast` can also be used at hypotheses and with extra simp rules.

```lean
example (a b : ℕ) (h1 : ((a + b : ℕ) : ℤ) = 10) (h2 : ((a + b + 0 : ℕ) : ℤ) = 10) :
  ((a + b : ℕ) : ℤ) = 10 :=
begin
  push_cast,
  push_cast at h1,
  push_cast [int.add_zero] at h2,
end
```
-/
end tactic.interactive

namespace norm_cast

/-- Prove `a = b` using the given simp set. -/
/-- Prove `a = b` by simplifying using move and squash lemmas. -/
/--
This is the main heuristic used alongside the elim and move lemmas.
The goal is to help casts move past operators by adding intermediate casts.
An expression of the shape: op (↑(x : α) : γ) (↑(y : β) : γ)
is rewritten to:            op (↑(↑(x : α) : β) : γ) (↑(y : β) : γ)
when (↑(↑(x : α) : β) : γ) = (↑(x : α) : γ) can be proven with a squash lemma
-/
/--
Discharging function used during simplification in the "squash" step.

TODO: norm_cast takes a list of expressions to use as lemmas for the discharger
TODO: a tactic to print the results the discharger fails to proove
-/
/--
Core rewriting function used in the "squash" step, which moves casts upwards
and eliminates them.

It tries to rewrite an expression using the elim and move lemmas.
On failure, it calls the splitting procedure heuristic.
-/
/-!
The following auxiliary functions are used to handle numerals.
-/

/--
If possible, rewrite `(n : α)` to `((n : ℕ) : α)` where `n` is a numeral and `α ≠ ℕ`.
Returns a pair of the new expression and proof that they are equal.
-/
/--
If possible, rewrite `((n : ℕ) : α)` to `(n : α)` where `n` is a numeral.
Returns a pair of the new expression and proof that they are equal.
-/
/-- A local variant on `simplify_top_down`. -/
/--
The core simplification routine of `norm_cast`.
-/
/--
A small variant of `push_cast` suited for non-interactive use.

`derive_push_cast extra_lems e` returns an expression `e'` and a proof that `e = e'`.
-/
end norm_cast

namespace tactic

/-- `aux_mod_cast e` runs `norm_cast` on `e` and returns the result. If `include_goal` is true, it
also normalizes the goal. -/
/-- `exact_mod_cast e` runs `norm_cast` on the goal and `e`, and tries to use `e` to close the goal. -/
/-- `apply_mod_cast e` runs `norm_cast` on the goal and `e`, and tries to apply `e`. -/
/-- `assumption_mod_cast` runs `norm_cast` on the goal. For each local hypothesis `h`, it also
normalizes `h` and tries to use that to close the goal. -/
end tactic

namespace tactic.interactive

/--
Normalize casts at the given locations by moving them "upwards".
As opposed to simp, norm_cast can be used without necessarily closing the goal.
-/
/--
Rewrite with the given rules and normalize casts between steps.
-/
/--
Normalize the goal and the given expression, then close the goal with exact.
-/
/--
Normalize the goal and the given expression, then apply the expression to the goal.
-/
/--
Normalize the goal and every expression in the local context, then close the goal with assumption.
-/
end tactic.interactive

namespace conv.interactive

/-- the converter version of `norm_cast' -/
end conv.interactive

-- TODO: move this elsewhere?

theorem ite_cast {α : Sort u_1} {β : Sort u_2} [has_lift_t α β] {c : Prop} [Decidable c] {a : α}
    {b : α} : ↑(ite c a b) = ite c ↑a ↑b :=
  sorry

/--
The `norm_cast` family of tactics is used to normalize casts inside expressions.
It is basically a simp tactic with a specific set of lemmas to move casts
upwards in the expression.
Therefore it can be used more safely as a non-terminating tactic.
It also has special handling of numerals.

For instance, given an assumption
```lean
a b : ℤ
h : ↑a + ↑b < (10 : ℚ)
```

writing `norm_cast at h` will turn `h` into
```lean
h : a + b < 10
```

You can also use `exact_mod_cast`, `apply_mod_cast`, `rw_mod_cast`
or `assumption_mod_cast`.
Writing `exact_mod_cast h` and `apply_mod_cast h` will normalize the goal and
`h` before using `exact h` or `apply h`.
Writing `assumption_mod_cast` will normalize the goal and for every
expression `h` in the context it will try to normalize `h` and use
`exact h`.
`rw_mod_cast` acts like the `rw` tactic but it applies `norm_cast` between steps.

`push_cast` rewrites the expression to move casts toward the leaf nodes.
This uses `norm_cast` lemmas in the forward direction.
For example, `↑(a + b)` will be written to `↑a + ↑b`.
It is equivalent to `simp only with push_cast`.
It can also be used at hypotheses with `push_cast at h`
and with extra simp lemmas with `push_cast [int.add_zero]`.

```lean
example (a b : ℕ) (h1 : ((a + b : ℕ) : ℤ) = 10) (h2 : ((a + b + 0 : ℕ) : ℤ) = 10) :
  ((a + b : ℕ) : ℤ) = 10 :=
begin
  push_cast,
  push_cast at h1,
  push_cast [int.add_zero] at h2,
end
```

The implementation and behavior of the `norm_cast` family is described in detail at
<https://lean-forward.github.io/norm_cast/norm_cast.pdf>.
-/
/--
The `norm_cast` attribute should be given to lemmas that describe the
end Mathlib


open tactic

namespace conj

variables a b : Prop

-- example : a → b → a ∧ b := by _

-- example : a → b → a ∧ b := by do
--   eh1 ← intro `h1,
--   eh2 ← intro `h2,
--   target >>= trace

-- example : a → b → a ∧ b := by do
--   eh1 ← intro `h1,
--   eh2 ← intro `h2,
--   local_context >>= trace

-- example : a → b → a ∧ b := by do
--   intro `h1,
--   intro `h2,
--   ea ← get_local `a,
--   eb ← get_local `b,
--   trace (to_string ea ++ ", " ++ to_string eb),
--   skip

example : a → b → a ∧ b := by do
  eh1 ← intro `h1,
  eh2 ← intro `h2,
  mk_const ``and.intro >>= apply,
    exact eh1,
  exact eh2

example : a → b → a ∧ b := by do
  eh1 ← intro `h1,
  eh2 ← intro `h2,
  applyc ``and.intro,
  exact eh1,
  exact eh2

example : a → b → a ∧ b :=
by do eh1 ← intro `h1,
      eh2 ← intro `h2,
      e ← to_expr ```(and.intro h1 h2),
      exact e

meta def my_tactic : tactic unit :=
do eh1 ← intro `h1,
   eh2 ← intro `h2,
   e ← to_expr ``(and.intro %%eh1 %%eh2),
   exact e

example : a → b → a ∧ b :=
by my_tactic

example (a b : Prop) (h : a ∧ b) : b ∧ a := by do
  split,
  to_expr ```(and.right h) >>= exact,
  to_expr ```(and.left h) >>= exact

namespace foo

theorem bar : true := trivial

meta def my_tac : tactic unit :=
mk_const ``bar >>= exact

example : true := by my_tac

end foo

example (a : Prop) : a → a :=
by do n ← mk_fresh_name,
      intro n,
      hyp ← get_local n,
      exact hyp

example (a b : Prop) (h : a ∧ b) : b ∧ a :=
by do split,
   eh ← get_local `h,
   mk_mapp ``and.right [none, none, some eh] >>= exact,
   mk_mapp ``and.left [none, none, some eh] >>= exact

example (a b : Prop) (h : a ∧ b) : b ∧ a :=
by do split,
      ea ← get_local `a,
      eb ← get_local `b,
      eh ← get_local `h,
      mk_app ``and.right [ea, eb, eh] >>= exact,
      mk_app ``and.left [ea, eb, eh] >>= exact

example (a b : Prop) (h : a ∧ b) : b ∧ a :=
by do split,
      eh ← get_local `h,
      mk_app ``and.right [eh] >>= exact,
      mk_app ``and.left [eh] >>= exact

example (a b : Prop) (h : a ∧ b) : b ∧ a :=
by do split,
      eh ← get_local `h,
      mk_const ``and.right >>= apply,
      exact eh,
      mk_const ``and.left >>= apply,
      exact eh

example (a b : Prop) (h : a ∧ b) : b ∧ a := by do
  split,
  to_expr ```(and.right h) >>= exact,
  to_expr ```(and.left h) >>= exact

example (a b : Prop) (h : a ∧ b) : b ∧ a := by do
  split,
  eh ← get_local `h,
  to_expr ``(and.right %%eh) >>= exact,
  to_expr ``(and.left %%eh) >>= exact

end conj

namespace hidden

meta def find_same_type : expr → list expr → tactic expr
| e []         := failed
| e (h :: hs) :=
  do t ← infer_type h,
     (unify e t >> return h) <|> find_same_type e hs

meta def assumption : tactic unit :=
do ctx ← local_context,
   t   ← target,
   h   ← find_same_type t ctx,
   exact h
<|> fail "assumption tactic failed"

meta def first {α : Type} : list (tactic α) → tactic α
| []      := fail "first tactic failed, no more alternatives"
| (t::ts) := t <|> first ts

end hidden

meta def destruct_conjunctions : tactic unit :=
repeat (do
  l ← local_context,
  first $ l.map (λ h, do
    ht ← infer_type h >>= whnf,
    match ht with
    | `(and %%a %%b) := do
      n ← get_unused_name `h none,
      mk_mapp ``and.left [none, none, some h] >>= assertv n a,
      n ← get_unused_name `h none,
      mk_mapp ``and.right [none, none, some h] >>= assertv n b,
      clear h
    | _ := failed
    end))

namespace hidden

open nat

meta def repeat_at_most : nat → tactic unit → tactic unit
| 0        t := skip
| (succ n) t := (do t, repeat_at_most n t) <|> skip

meta def repeat : tactic unit → tactic unit :=
repeat_at_most 100000

end hidden

set_option pp.beta false

section
  variables {α : Type} (a b : α)

  example : (λ x : α, a) b = a :=
  by do goal ← target,
        match expr.is_eq goal with
        | (some (e₁, e₂)) := do trace e₁,
                                whnf e₁ >>= trace,
                                reflexivity
        | none            := failed
        end

  example : (λ x : α, a) b = a :=
  by do goal ← target,
        match expr.is_eq goal with
        | (some (e₁, e₂)) := do trace e₁,
                                whnf e₁ transparency.none >>= trace,
                                reflexivity
        | none            := failed
        end

  attribute [reducible]
  definition foo (a b : α) : α := a

  example : foo a b = a :=
  by do goal ← target,
        match expr.is_eq goal with
        | (some (e₁, e₂)) := do trace e₁,
                                whnf e₁ transparency.none >>= trace,
                                reflexivity
        | none            := failed
        end

  example : foo a b = a :=
  by do goal ← target,
        match expr.is_eq goal with
        | (some (e₁, e₂)) := do trace e₁,
                                whnf e₁ transparency.reducible >>= trace,
                                reflexivity
        | none            := failed
        end
end


namespace Sexp

inductive Sexp
| atom (s : String)
| slist (ss : List Sexp)

namespace Sexp

def atomToString (s : String) : String :=
  if s.isEmpty || s.any ("\"() ".contains) then
    "\"" ++ String.replace s "\"" "\\\"" ++ "\""
  else
    s

theorem atomToString_nonempty (s : String)
  : (atomToString s).isEmpty = false
  := by
  simp [atomToString]
  split
  case inl h =>
    generalize String.replace s _ _ = s
    simp [HAppend.hAppend, Append.append, String.append]
    simp [String.isEmpty, String.endPos, String.utf8ByteSize, String.utf8ByteSize.go]
    generalize String.utf8ByteSize.go _ = rest
    simp [BEq.beq]
    apply decide_eq_false
    intro h
    cases h
  case inr h =>
    apply Decidable.byCases id
    intro h'
    have := eq_true_of_ne_false h'
    simp [this] at h

mutual
def toString : Sexp → String
| atom s => atomToString s
| slist ss => "(" ++ listToString ss ++ ")"

def listToString : List Sexp → String
| [] => ""
| [s] => toString s
| s :: ss => toString s ++ " " ++ listToString ss
end

instance : ToString Sexp where
  toString := toString

#eval (slist [
  (atom "hi"),
  (atom "bye"),
  (atom "no \"really"),
  (slist [(atom "what"), (atom "oh")])
])