import category_theory.preadditive
import category_theory.abelian.projective
import category_theory.abelian.diagram_lemmas.four

import data.matrix.notation

import for_mathlib.abelian_category
import for_mathlib.fin_functor
import for_mathlib.split_exact

noncomputable theory

open category_theory
open category_theory.limits
open category_theory.preadditive

universes v u

namespace category_theory
variables (𝒞 : Type u) [category.{v} 𝒞]

@[ext]
structure short_exact_sequence [has_images 𝒞] [has_zero_morphisms 𝒞] [has_kernels 𝒞] :=
(fst snd trd : 𝒞)
(f : fst ⟶ snd)
(g : snd ⟶ trd)
[mono'  : mono f]
[epi'   : epi g]
(exact' : exact f g)

namespace short_exact_sequence

attribute [instance] mono' epi'

variables {𝒞} [has_images 𝒞] [has_zero_morphisms 𝒞] [has_kernels 𝒞]

@[simp, reassoc] lemma f_comp_g (A : short_exact_sequence 𝒞) : A.f ≫ A.g = 0 := A.exact'.w

@[ext]
structure hom (A B : short_exact_sequence 𝒞) :=
(fst : A.1 ⟶ B.1)
(snd : A.2 ⟶ B.2)
(trd : A.3 ⟶ B.3)
(sq1' : fst ≫ B.f = A.f ≫ snd . obviously)
(sq2' : snd ≫ B.g = A.g ≫ trd . obviously)

namespace hom

restate_axiom sq1' sq1
restate_axiom sq2' sq2

attribute [reassoc] sq1 sq2

end hom

instance : quiver (short_exact_sequence 𝒞) := ⟨hom⟩

def id (A : short_exact_sequence 𝒞) : A ⟶ A :=
{ fst := 𝟙 _,
  snd := 𝟙 _,
  trd := 𝟙 _,
  sq1' := by simp only [category.id_comp, category.comp_id],
  sq2' := by simp only [category.id_comp, category.comp_id], }

def comp {A B C : short_exact_sequence 𝒞} (f : A ⟶ B) (g : B ⟶ C) : A ⟶ C :=
{ fst := f.1 ≫ g.1,
  snd := f.2 ≫ g.2,
  trd := f.3 ≫ g.3,
  sq1' := by rw [category.assoc, hom.sq1, hom.sq1_assoc],
  sq2' := by rw [category.assoc, hom.sq2, hom.sq2_assoc], }

instance : category (short_exact_sequence 𝒞) :=
{ id := id,
  comp := λ A B C f g, comp f g,
  id_comp' := by { intros, ext; dsimp; apply category.id_comp, },
  comp_id' := by { intros, ext; dsimp; apply category.comp_id, },
  assoc' := by { intros, ext; dsimp; apply category.assoc, },
  .. (infer_instance : quiver (short_exact_sequence 𝒞)) }

@[simp] lemma id_fst (A : short_exact_sequence 𝒞) : hom.fst (𝟙 A) = 𝟙 A.1 := rfl
@[simp] lemma id_snd (A : short_exact_sequence 𝒞) : hom.snd (𝟙 A) = 𝟙 A.2 := rfl
@[simp] lemma id_trd (A : short_exact_sequence 𝒞) : hom.trd (𝟙 A) = 𝟙 A.3 := rfl

variables {A B C : short_exact_sequence 𝒞} (f : A ⟶ B) (g : B ⟶ C)

@[simp, reassoc] lemma comp_fst : (f ≫ g).1 = f.1 ≫ g.1 := rfl
@[simp, reassoc] lemma comp_snd : (f ≫ g).2 = f.2 ≫ g.2 := rfl
@[simp, reassoc] lemma comp_trd : (f ≫ g).3 = f.3 ≫ g.3 := rfl

variables (𝒞)

@[simps] def Fst : short_exact_sequence 𝒞 ⥤ 𝒞 :=
{ obj := fst, map := λ A B f, f.1 }

@[simps] def Snd : short_exact_sequence 𝒞 ⥤ 𝒞 :=
{ obj := snd, map := λ A B f, f.2 }

@[simps] def Trd : short_exact_sequence 𝒞 ⥤ 𝒞 :=
{ obj := trd, map := λ A B f, f.3 }

@[simps] def f_nat : Fst 𝒞 ⟶ Snd 𝒞 :=
{ app := λ A, A.f,
  naturality' := λ A B f, f.sq1 }

@[simps] def g_nat : Snd 𝒞 ⟶ Trd 𝒞 :=
{ app := λ A, A.g,
  naturality' := λ A B f, f.sq2 }

instance : has_zero_morphisms (short_exact_sequence 𝒞) :=
{ has_zero := λ A B, ⟨{ fst := 0, snd := 0, trd := 0 }⟩,
  comp_zero' := by { intros, ext; apply comp_zero },
  zero_comp' := by { intros, ext; apply zero_comp }, }
.

@[simp] lemma hom_zero_fst : (0 : A ⟶ B).1 = 0 := rfl

@[simp] lemma hom_zero_snd : (0 : A ⟶ B).2 = 0 := rfl

@[simp] lemma hom_zero_trd : (0 : A ⟶ B).3 = 0 := rfl

variables {𝒞}

protected def functor (A : short_exact_sequence 𝒞) : fin 3 ⥤ 𝒞 :=
fin3_functor_mk ![A.1, A.2, A.3] A.f A.g

def functor_map {A B : short_exact_sequence 𝒞} (f : A ⟶ B) :
  Π i, A.functor.obj i ⟶ B.functor.obj i
| ⟨0,h⟩ := f.1
| ⟨1,h⟩ := f.2
| ⟨2,h⟩ := f.3
| ⟨i+3,hi⟩ := by { exfalso, revert hi, dec_trivial }

meta def aux_tac : tactic unit :=
`[simp only [hom_of_le_refl, functor.map_id, category.id_comp, category.comp_id]]

lemma functor_map_naturality {A B : short_exact_sequence 𝒞} (f : A ⟶ B) :
  ∀ (i j : fin 3) (hij : i ≤ j),
    functor_map f i ≫ B.functor.map hij.hom = A.functor.map hij.hom ≫ functor_map f j
| ⟨0,hi⟩ ⟨0,hj⟩ hij := by aux_tac
| ⟨1,hi⟩ ⟨1,hj⟩ hij := by aux_tac
| ⟨2,hi⟩ ⟨2,hj⟩ hij := by aux_tac
| ⟨0,hi⟩ ⟨1,hj⟩ hij := f.sq1
| ⟨1,hi⟩ ⟨2,hj⟩ hij := f.sq2
| ⟨i+3,hi⟩ _ _ := by { exfalso, revert hi, dec_trivial }
| _ ⟨j+3,hj⟩ _ := by { exfalso, revert hj, dec_trivial }
| ⟨i+1,hi⟩ ⟨0,hj⟩ H := by { exfalso, revert H, dec_trivial }
| ⟨i+2,hi⟩ ⟨1,hj⟩ H := by { exfalso, revert H, dec_trivial }
| ⟨0,hi⟩ ⟨2,hj⟩ hij :=
begin
  have h01 : (0 : fin 3) ⟶ 1 := hom_of_le dec_trivial,
  have h12 : (1 : fin 3) ⟶ 2 := hom_of_le dec_trivial,
  calc functor_map f ⟨0, hi⟩ ≫ B.functor.map hij.hom
      = functor_map f ⟨0, hi⟩ ≫ B.functor.map h01 ≫ B.functor.map h12 : _
  ... = (functor_map f ⟨0, hi⟩ ≫ B.functor.map h01) ≫ B.functor.map h12 : by rw category.assoc
  ... = (A.functor.map h01 ≫ functor_map f _) ≫ B.functor.map h12 : _
  ... = A.functor.map h01 ≫ functor_map f _ ≫ B.functor.map h12 : category.assoc _ _ _
  ... = A.functor.map h01 ≫ A.functor.map h12 ≫ functor_map f _ : _
  ... = A.functor.map hij.hom ≫ functor_map f ⟨2, hj⟩ : _,
  { rw [← functor.map_comp], congr, },
  { congr' 1, exact f.sq1 },
  { congr' 1, exact f.sq2 },
  { rw [← functor.map_comp_assoc], congr, },
end

@[simps] def Functor : short_exact_sequence 𝒞 ⥤ fin 3 ⥤ 𝒞 :=
{ obj := short_exact_sequence.functor,
  map := λ A B f,
  { app := functor_map f,
    naturality' := λ i j hij, (functor_map_naturality f i j hij.le).symm },
  map_id' := λ A, by { ext i, fin_cases i; refl },
  map_comp' := λ A B C f g, by { ext i, fin_cases i; refl } }

end short_exact_sequence

namespace short_exact_sequence

variables {𝒞} [abelian 𝒞]
variables {A B C : short_exact_sequence 𝒞} (f : A ⟶ B) (g : B ⟶ C)

section iso

variables {A B C} (f g)

open_locale zero_object

/-- One form of the five lemma: if a morphism of short exact sequences has isomorphisms
as first and third component, then the second component is also an isomorphism. -/
lemma snd_is_iso (h1 : is_iso f.1) (h3 : is_iso f.3) : is_iso f.2 :=
@abelian.is_iso_of_is_iso_of_is_iso_of_is_iso_of_is_iso 𝒞 _ _
  0 A.1 A.2 A.3
  0 B.1 B.2 B.3
  0 A.f A.g
  0 B.f B.g
  0 f.1 f.2 f.3 (by rw [zero_comp, zero_comp]) f.sq1 f.sq2
  0 0
  0 0 0 (by rw [comp_zero, comp_zero])
  (exact_zero_left_of_mono _)
  A.exact'
  ((epi_iff_exact_zero_right _).mp infer_instance)
  (exact_zero_left_of_mono _)
  B.exact'
  ((epi_iff_exact_zero_right _).mp infer_instance) _ _ _ _

/-- One form of the five lemma: if a morphism `f` of short exact sequences has isomorphisms
as first and third component, then `f` itself is an isomorphism. -/
lemma is_iso_of_fst_of_trd (h1 : is_iso f.1) (h3 : is_iso f.3) : is_iso f :=
{ out :=
  begin
    haveI : is_iso f.2 := snd_is_iso f h1 h3,
    refine ⟨⟨inv f.1, inv f.2, inv f.3, _, _⟩, _, _⟩,
    { dsimp, simp only [is_iso.inv_comp_eq, f.sq1_assoc, category.comp_id, is_iso.hom_inv_id], },
    { dsimp, simp only [is_iso.inv_comp_eq, f.sq2_assoc, category.comp_id, is_iso.hom_inv_id], },
    { ext; dsimp; simp only [is_iso.hom_inv_id], },
    { ext; dsimp; simp only [is_iso.inv_hom_id], },
  end }

@[simps] def iso_of_components (f₁ : A.1 ≅ B.1) (f₂ : A.2 ≅ B.2) (f₃ : A.3 ≅ B.3)
  (sq1 : f₁.hom ≫ B.f = A.f ≫ f₂.hom) (sq2 : f₂.hom ≫ B.g = A.g ≫ f₃.hom) :
  A ≅ B :=
{ hom := ⟨f₁.hom, f₂.hom, f₃.hom, sq1, sq2⟩,
  inv :=
  begin
    refine ⟨f₁.inv, f₂.inv, f₃.inv, _, _⟩; dsimp,
    rw [iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv, sq1],
    rw [iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv, sq2],
  end,
  hom_inv_id' := by { ext; apply iso.hom_inv_id, },
  inv_hom_id' := by { ext; apply iso.inv_hom_id, } }

@[simps] def iso_of_components' (f₁ : A.1 ≅ B.1) (f₂ : A.2 ⟶ B.2) (f₃ : A.3 ≅ B.3)
  (sq1 : f₁.hom ≫ B.f = A.f ≫ f₂) (sq2 : f₂ ≫ B.g = A.g ≫ f₃.hom) :
  A ≅ B :=
let F : A ⟶ B := ⟨f₁.hom, f₂, f₃.hom, sq1, sq2⟩ in
{ hom := F,
  inv :=
  begin
    haveI : is_iso F.2 := snd_is_iso _ infer_instance infer_instance,
    refine ⟨f₁.inv, inv F.2, f₃.inv, _, _⟩; dsimp,
    rw [iso.inv_comp_eq, ← category.assoc, is_iso.eq_comp_inv, sq1],
    rw [is_iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv, sq2],
  end,
  hom_inv_id' := by { ext; try { apply iso.hom_inv_id, }, apply is_iso.hom_inv_id },
  inv_hom_id' := by { ext; try { apply iso.inv_hom_id, }, apply is_iso.inv_hom_id } }

end iso

section split

/-- A short exact sequence `0 ⟶ A₁ -f⟶ A₂ -g⟶ A₃ ⟶ 0` is *left split*
if there exists a morphism `φ : A₂ ⟶ A₁` such that `f ≫ φ = 𝟙 A₁`. -/
def left_split (A : short_exact_sequence 𝒞) : Prop :=
∃ φ : A.2 ⟶ A.1, A.f ≫ φ = 𝟙 A.1

/-- A short exact sequence `0 ⟶ A₁ -f⟶ A₂ -g⟶ A₃ ⟶ 0` is *right split*
if there exists a morphism `φ : A₂ ⟶ A₁` such that `f ≫ φ = 𝟙 A₁`. -/
def right_split (A : short_exact_sequence 𝒞) : Prop :=
∃ χ : A.3 ⟶ A.2, χ ≫ A.g = 𝟙 A.3

variables {𝒜 : Type*} [category 𝒜] [abelian 𝒜]

lemma exact_of_split {A B C : 𝒜} (f : A ⟶ B) (g : B ⟶ C) (χ : C ⟶ B) (φ : B ⟶ A)
  (hfg : f ≫ g = 0) (H : φ ≫ f + g ≫ χ = 𝟙 B) : exact f g :=
{ w := hfg,
  epi :=
  begin
    let ψ : (kernel_subobject g : 𝒜) ⟶ image_subobject f :=
      subobject.arrow _ ≫ φ ≫ factor_thru_image_subobject f,
    suffices : ψ ≫ image_to_kernel f g hfg = 𝟙 _,
    { convert epi_of_epi ψ _, rw this, apply_instance },
    rw ← cancel_mono (subobject.arrow _), swap, { apply_instance },
    simp only [image_to_kernel_arrow, image_subobject_arrow_comp, category.id_comp, category.assoc],
    calc (kernel_subobject g).arrow ≫ φ ≫ f
        = (kernel_subobject g).arrow ≫ 𝟙 B : _
    ... = (kernel_subobject g).arrow        : category.comp_id _,
    rw [← H, preadditive.comp_add],
    simp only [add_zero, zero_comp, kernel_subobject_arrow_comp_assoc],
  end }

-- move this
lemma exact_inl_snd (A B : 𝒜) : exact (biprod.inl : A ⟶ A ⊞ B) biprod.snd :=
exact_of_split _ _ biprod.inr biprod.fst biprod.inl_snd biprod.total

def mk_of_split {A B C : 𝒜} (f : A ⟶ B) (g : B ⟶ C) (φ : B ⟶ A) (χ : C ⟶ B)
  (hfg : f ≫ g = 0) (hφ : f ≫ φ = 𝟙 A) (hχ : χ ≫ g = 𝟙 C) (H : φ ≫ f + g ≫ χ = 𝟙 B) :
  short_exact_sequence 𝒜 :=
{ fst := A,
  snd := B,
  trd := C,
  f := f,
  g := g,
  mono' := by { haveI : mono (f ≫ φ), { rw hφ, apply_instance }, exact mono_of_mono f φ, },
  epi' := by { haveI : epi (χ ≫ g), { rw hχ, apply_instance }, exact epi_of_epi χ g, },
  exact' := exact_of_split f g χ φ hfg H }

def mk_of_split' {A B C : 𝒜} (f : A ⟶ B) (g : B ⟶ C)
  (H : ∃ (φ : B ⟶ A) (χ : C ⟶ B), f ≫ g = 0 ∧ f ≫ φ = 𝟙 A ∧ χ ≫ g = 𝟙 C ∧ φ ≫ f + g ≫ χ = 𝟙 B) :
  short_exact_sequence 𝒜 :=
mk_of_split f g H.some H.some_spec.some H.some_spec.some_spec.1 H.some_spec.some_spec.2.1
  H.some_spec.some_spec.2.2.1 H.some_spec.some_spec.2.2.2

@[simp] def mk_split (A B : 𝒜) : short_exact_sequence 𝒜 :=
{ fst := A,
  snd := A ⊞ B,
  trd := B,
  f := biprod.inl,
  g := biprod.snd,
  exact' := exact_inl_snd _ _ }

/-- A *splitting* of a short exact sequence `0 ⟶ A₁ -f⟶ A₂ -g⟶ A₃ ⟶ 0` is
an isomorphism to the short exact sequence `0 ⟶ A₁ ⟶ A₁ ⊕ A₃ ⟶ A₃ ⟶ 0`,
where the left and right components of the isomorphism are identity maps. -/
structure splitting (A : short_exact_sequence 𝒜) extends A ≅ (mk_split A.1 A.3) :=
(fst_eq_id : hom.1 = 𝟙 A.1)
(trd_eq_id : hom.3 = 𝟙 A.3)

/-- A short exact sequence `0 ⟶ A₁ -f⟶ A₂ -g⟶ A₃ ⟶ 0` is *split* if there exist
`φ : A₂ ⟶ A₁` and `χ : A₃ ⟶ A₂` such that:
* `f ≫ φ = 𝟙 A₁`
* `χ ≫ g = 𝟙 A₃`
* `χ ≫ φ = 0`
* `φ ≫ f + g ≫ χ = 𝟙 A₂`
-/
def split (A : short_exact_sequence 𝒜) : Prop :=
∃ (φ : A.2 ⟶ A.1) (χ : A.3 ⟶ A.2),
   A.f ≫ φ = 𝟙 A.1 ∧ χ ≫ A.g = 𝟙 A.3 ∧ χ ≫ φ = 0 ∧ φ ≫ A.f + A.g ≫ χ = 𝟙 A.2

lemma mk_split_split (A B : 𝒜) : (mk_split A B).split :=
⟨biprod.fst, biprod.inr, biprod.inl_fst, biprod.inr_snd, biprod.inr_fst, biprod.total⟩

lemma splitting.split {A : short_exact_sequence 𝒜} (i : splitting A) : A.split :=
begin
  refine ⟨i.hom.2 ≫ biprod.fst ≫ i.inv.1, i.hom.3 ≫ biprod.inr ≫ i.inv.2, _⟩,
  simp only [category.assoc, ← hom.sq1_assoc, hom.sq2], dsimp,
  simp only [biprod.inl_fst_assoc, biprod.inr_snd_assoc, category.comp_id, category.assoc,
    ← comp_fst, ← comp_snd_assoc, ← comp_trd, i.to_iso.hom_inv_id, i.to_iso.inv_hom_id],
  dsimp,
  simp only [true_and, biprod.inr_fst_assoc, zero_comp, eq_self_iff_true, comp_zero,
    category.id_comp],
  simp only [hom.sq1, ← hom.sq2_assoc, ← comp_add],
  simp only [← category.assoc, ← add_comp, biprod.total,
    category.comp_id, ← comp_snd, i.to_iso.hom_inv_id], refl,
end

def left_split.splitting {A : short_exact_sequence 𝒜} (h : A.left_split) : A.splitting :=
{ to_iso := iso_of_components' (iso.refl _) (biprod.lift h.some A.g) (iso.refl _)
    (by { dsimp, simp only [category.id_comp], ext,
      { simpa only [biprod.inl_fst, biprod.lift_fst, category.assoc] using h.some_spec.symm, },
      { simp only [exact.w, f_comp_g, biprod.lift_snd, category.assoc, exact_inl_snd] } })
    (by { dsimp, simp only [category.comp_id, biprod.lift_snd], }),
  fst_eq_id := rfl,
  trd_eq_id := rfl }

def right_split.splitting {A : short_exact_sequence 𝒜} (h : A.right_split) : A.splitting :=
{ to_iso := iso.symm $ iso_of_components' (iso.refl _) (biprod.desc A.f h.some) (iso.refl _)
    (by { dsimp, simp only [biprod.inl_desc, category.id_comp], })
    (by { dsimp, simp only [category.comp_id], ext,
      { simp only [exact.w, f_comp_g, biprod.inl_desc_assoc, exact_inl_snd] },
      { simpa only [biprod.inr_snd, biprod.inr_desc_assoc] using h.some_spec, } }),
  fst_eq_id := rfl,
  trd_eq_id := rfl }

lemma tfae_split (A : short_exact_sequence 𝒜) :
  tfae [A.left_split, A.right_split, A.split, nonempty A.splitting] :=
begin
  tfae_have : 3 → 1, { rintro ⟨φ, χ, hφ, hχ, hχφ, H⟩, exact ⟨φ, hφ⟩ },
  tfae_have : 3 → 2, { rintro ⟨φ, χ, hφ, hχ, hχφ, H⟩, exact ⟨χ, hχ⟩ },
  tfae_have : 4 → 3, { rintro ⟨i⟩, exact i.split, },
  tfae_have : 1 → 4, { intro h, exact ⟨h.splitting⟩ },
  tfae_have : 2 → 4, { intro h, exact ⟨h.splitting⟩ },
  tfae_finish
end

end split

end short_exact_sequence

namespace short_exact_sequence

open category_theory.preadditive

variables {𝒞} [preadditive 𝒞] [has_images 𝒞] [has_kernels 𝒞]
variables (A B : short_exact_sequence 𝒞)

local notation `π₁` := congr_arg _root_.prod.fst
local notation `π₂` := congr_arg _root_.prod.snd

protected def hom_inj (f : A ⟶ B) : (A.1 ⟶ B.1) × (A.2 ⟶ B.2) × (A.3 ⟶ B.3) := ⟨f.1, f.2, f.3⟩

protected lemma hom_inj_injective : function.injective (short_exact_sequence.hom_inj A B) :=
λ f g h, let aux := π₂ h in
by { ext; [have := π₁ h, have := π₁ aux, have := π₂ aux]; exact this, }

instance : has_add (A ⟶ B) :=
{ add := λ f g,
  { fst := f.1 + g.1,
    snd := f.2 + g.2,
    trd := f.3 + g.3,
    sq1' := by { rw [add_comp, comp_add, f.sq1, g.sq1], },
    sq2' := by { rw [add_comp, comp_add, f.sq2, g.sq2], } } }

instance : has_neg (A ⟶ B) :=
{ neg := λ f,
  { fst := -f.1,
    snd := -f.2,
    trd := -f.3,
    sq1' := by { rw [neg_comp, comp_neg, f.sq1], },
    sq2' := by { rw [neg_comp, comp_neg, f.sq2], } } }

instance : has_sub (A ⟶ B) :=
{ sub := λ f g,
  { fst := f.1 - g.1,
    snd := f.2 - g.2,
    trd := f.3 - g.3,
    sq1' := by { rw [sub_comp, comp_sub, f.sq1, g.sq1], },
    sq2' := by { rw [sub_comp, comp_sub, f.sq2, g.sq2], } } }

instance has_nsmul : has_smul ℕ (A ⟶ B) :=
{ smul := λ n f,
  { fst := n • f.1,
    snd := n • f.2,
    trd := n • f.3,
    sq1' := by rw [nsmul_comp, comp_nsmul, f.sq1],
    sq2' := by rw [nsmul_comp, comp_nsmul, f.sq2] } }

instance has_zsmul : has_smul ℤ (A ⟶ B) :=
{ smul := λ n f,
  { fst := n • f.1,
    snd := n • f.2,
    trd := n • f.3,
    sq1' := by rw [zsmul_comp, comp_zsmul, f.sq1],
    sq2' := by rw [zsmul_comp, comp_zsmul, f.sq2] } }

variables (𝒞)

instance : preadditive (short_exact_sequence 𝒞) :=
{ hom_group := λ A B, (short_exact_sequence.hom_inj_injective A B).add_comm_group _
  rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl),
  add_comp' := by { intros, ext; apply add_comp },
  comp_add' := by { intros, ext; apply comp_add }, }
.

instance Fst_additive : (Fst 𝒞).additive := {}
instance Snd_additive : (Snd 𝒞).additive := {}
instance Trd_additive : (Trd 𝒞).additive := {}

end short_exact_sequence

end category_theory


import category_theory.isomorphism
import homotopy_theory.formal.cylinder.hep

import .category
import .colimits
import .cylinder
import .interval_endpoints
import .pair
import .pushout_lemmas

open set

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

open homotopy_theory.cylinder

namespace homotopy_theory.topological_spaces
open homotopy_theory.topological_spaces.Top
local notation `Top` := Top.{0}

-- The classical definition of a cofibration between topological
-- spaces as a map which satisfies the homotopy extension property.
def cofibration {A X : Top} (j : A ⟶ X) : Prop := hep 0 j

/-

* A cofibration in Top is an embedding. [Strøm, Note on cofibrations,
  Theorem 1.] Proof: Suppose j : A → X is a cofibration. Form the
  mapping cylinder Z as the pushout shown below, with induced map
  k : Z → IX.

      j
    A → X = X
  i₀↓   ↓   ↓i₀
   IA → Z → IX → Z
  i₁↑   ↑   ↑i₁
    A = A → X
          j

  By the homotopy extension property, we can find a map r from IX back
  to Z. So Z → X is the inclusion of a retract, hence in particular an
  embedding. The map i₀ : A → IA has closed image, so IA → Z is a
  homeomorphism onto its image away from the image of i₀. Thus the
  composition

      i₁
    A → IA → Z → IX

  is an embedding; but it equals i₁ ∘ j : A → IX, so j : A → X is an
  embedding as well.

-/

variables {A X : Top} {j : A ⟶ X}
local notation `i` := i.{0}

lemma embedding_i {ε} : embedding (i ε @> A) :=
embedding_of_embedding_comp (p @> A) embedding_id

lemma closed_i {ε} : is_closed (set.range (i ε @> A)) :=
have is_closed {p : Top.prod A I01 | p.snd ∈ ({I01_of_endpoint ε} : set I01)}, from
  continuous_iff_is_closed.mp continuous_snd _ is_closed_singleton,
begin
  convert this, ext p, cases p with a t,
  change (∃ a', (a', _) = (a, t)) ↔ _,
  simpa using eq_comm
end

lemma disjoint_i₀_i₁ : set.range (i 0 @> A) ∩ set.range (i 1 @> A) = ∅ :=
begin
  apply set.eq_empty_of_subset_empty, intros p hp,
  cases p with a t, rcases hp with ⟨⟨_, hp₀⟩, ⟨_, hp₁⟩⟩,
  have hp₀' : 0 = t := congr_arg prod.snd hp₀,
  have hp₁' : 1 = t := congr_arg prod.snd hp₁,
  have : (0 : I01) = 1 := hp₀'.trans hp₁'.symm,
  exact absurd (congr_arg subtype.val this)
    (show ¬(0 : ℝ) = 1, by norm_num)
end

lemma embedding_of_cofibration (h : cofibration j) : embedding j :=
let po := has_pushouts.pushout (i 0 @> A) j,
    Z := po.ob,
    k : Z ⟶ I.obj X :=
      po.is_pushout.induced (I &> j) (i 0 @> X) ((i 0).naturality j).symm,
    ⟨r, hr₀, hr₁⟩ := h Z po.map₁ po.map₀ po.is_pushout.commutes.symm in
have _ := hr₀.symm,
have hr : r ∘ k = 𝟙 _, by apply po.is_pushout.uniqueness; { rw ←assoc, simpa },
have e_z_ix : embedding k, from
  embedding_of_embedding_comp r (by rw hr; exact embedding_id),
have e_a_z : embedding (po.map₀ ∘ i 1 @> A), from
  comp_embedding_of_embedding_of_disjoint
    po.is_pushout (or.inl closed_i) embedding_i disjoint_i₀_i₁,
have embedding (k ∘ (po.map₀ ∘ i 1 @> A)), from e_z_ix.comp e_a_z,
have embedding (i 1 @> X ∘ j), begin
  convert this using 2,
  transitivity,
  exact (i 1).naturality j,
  simp
end,
embedding_of_embedding_comp _ this

lemma cofibration_iff_cofibered_of_embedding (e : embedding j) :
  cofibration j ↔ (pair.mk X (range j)).cofibered :=
let j' := Top.factor_through_incl j (range j) (subset.refl _) in
show hep 0 j ↔ hep 0 _, from
mem_iff_mem_of_isomorphic
  (homeomorphism_to_image_of_embedding e)
  (iso.refl X)
  (by ext p; refl)

lemma cofibration_iff_cofibered :
  cofibration j ↔ embedding j ∧ (pair.mk X (range j)).cofibered :=
iff.intro
  (assume h,
    have e : embedding j := embedding_of_cofibration h,
    ⟨e, (cofibration_iff_cofibered_of_embedding e).mp h⟩)
  (assume h, (cofibration_iff_cofibered_of_embedding h.1).mpr h.2)

section relative_cylinder
noncomputable theory

variables (j) (ha : is_closed (range j))
variable (hj : cofibration j)

lemma relative_cylinder' : ∃ Po : pushout (∂I &> j) (ii @> A),
  cofibration (Po.is_pushout.induced (ii @> X) (I &> j) (ii.naturality _)) ∧
  is_closed (range (Po.is_pushout.induced (ii @> X) (I &> j) (ii.naturality _))) :=
let P : pair := pair.mk X (range j) in
let j_ : homeomorphism A P.subspace :=
  homeomorphism_to_image_of_embedding (embedding_of_cofibration hj) in
let po := pair.po P I_01 ha I_01.is_closed in
let po' := Is_pushout_of_isomorphic po.transpose (∂I &> j) (ii @> A)
  ((∂I.map_iso j_).trans prod_doubleton) prod_doubleton (I.map_iso j_)
  (by apply coprod.uniqueness; refl)
  (by apply coprod.uniqueness; refl) in
let ind := po'.induced (ii @> X) (I &> j) (ii.naturality _) in
have ind = pair.incl _, begin
  dsimp [ind], apply po'.uniqueness,
  { apply coprod.uniqueness; simpa },
  { simpa },
end,
⟨⟨(P ⊗ I_01).subspace, _, _, po'⟩,
 begin
   change cofibration ind ∧ is_closed (range ind), rw this,
   refine ⟨prod_I_01_cofibered P ha (cofibration_iff_cofibered.mp hj).2, _⟩,
   convert @pair.prod.is_closed P I_01 ha I_01.is_closed using 1,
   apply subtype.range_val
 end⟩

end relative_cylinder

end homotopy_theory.topological_spaces


/-
Copyright (c) 2021 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg
-/

import data.int.basic
import tactic.aesop.percent
import tactic.aesop.rule
import tactic.aesop.rule_builder
import tactic.aesop.util

namespace tactic
namespace aesop

open lean
open lean.parser
open interactive (with_desc)
open interactive.types (list_of brackets)

@[derive has_reflect]
inductive builder_clause
| apply
| simp_lemma
| tactic

namespace builder_clause

meta def args_parser : lean.parser builder_clause :=
with_desc "apply | simp_lemma | tactic" $ do
  i ← ident,
  match i with
  | `apply := pure builder_clause.apply
  | `simp_lemma := pure builder_clause.simp_lemma
  | `tactic := pure builder_clause.tactic
  | _ := fail $ format! "Unknown builder: {i}"
  end

meta def to_rule_builder : builder_clause → rule_builder
| apply := rule_builder.apply
| simp_lemma := rule_builder.normalization_simp_lemma
| tactic := rule_builder.tac

end builder_clause

@[derive has_reflect]
structure safety_clause :=
(to_safety : safety)

namespace safety_clause

protected meta def safe_args_parser : lean.parser safety_clause :=
pure ⟨safety.safe⟩

protected meta def almost_safe_args_parser : lean.parser safety_clause :=
pure ⟨safety.almost_safe⟩

end safety_clause

@[derive has_reflect]
inductive rule_clause
| builder (c : builder_clause)
| safety (c : safety_clause)

meta def clause_parser {α}
  (simple_clauses : name_map α)
  (clauses : name_map (lean.parser α)) :
  lean.parser α :=
with_desc "clause" $
(do
  i ← ident,
  match simple_clauses.find i with
  | some v := pure v
  | none := failed
  end)
<|>
(brackets "(" ")" $ do
  i ← ident,
  match clauses.find i with
  | some arg_parser := arg_parser
  | none := fail $ format! "Unknown clause: {i}"
  end)

meta def simple_rule_clauses : name_map rule_clause :=
native.rb_map.of_list
  [ (`safe, rule_clause.safety ⟨safety.safe⟩),
    (`almost_safe, rule_clause.safety ⟨safety.almost_safe⟩) ]

meta def rule_clauses : name_map (lean.parser rule_clause) :=
native.rb_map.of_list
  [ (`builder, rule_clause.builder <$> builder_clause.args_parser),
    (`safe, rule_clause.safety <$> safety_clause.safe_args_parser),
    (`almost_safe, rule_clause.safety <$> safety_clause.almost_safe_args_parser) ]

namespace rule_clause

meta def parser : lean.parser rule_clause :=
clause_parser simple_rule_clauses rule_clauses

end rule_clause

@[derive has_reflect]
structure normalization_rule_config :=
(penalty : option ℤ := none)
(builder : option builder_clause := none)

namespace normalization_rule_config

meta def add_clause (conf : normalization_rule_config) :
  rule_clause → exceptional normalization_rule_config
| (rule_clause.builder c) :=
  if conf.builder.is_some
    then exceptional.fail "Duplicate builder clause not allowed."
    else pure { builder := some c, ..conf }
| (rule_clause.safety c) := exceptional.fail
  "Safety clause not allowed for normalization rules."

meta def add_clauses (clauses : list rule_clause)
  (conf : normalization_rule_config) : exceptional normalization_rule_config :=
clauses.mfoldl add_clause conf

meta def parser : lean.parser normalization_rule_config :=
with_desc "penalty (clause)..." $ do
  penalty ← optional small_int,
  clauses ← many rule_clause.parser,
  let init : normalization_rule_config := { penalty := penalty },
  init.add_clauses clauses

end normalization_rule_config

meta def normalization_declaration_to_rule (decl : name)
  (conf : normalization_rule_config) : tactic rule_set_member := do
  env ← get_env,
  d ← env.get decl,
  let builder :=
    (builder_clause.to_rule_builder <$> conf.builder).get_or_else
      rule_builder.normalization_default,
  r ← builder d,
  match r with
  | rule_builder_output.rule r imode :=
    pure $ rule_set_member.normalization_rule
      { penalty := conf.penalty.get_or_else 0, ..r }
      imode
  | rule_builder_output.simp_lemmas s := do
    when conf.penalty.is_some $ fail!
      "Penalty annotation is not allowed for norm equations (only for norm tactics).",
    pure $ rule_set_member.normalization_simp_lemmas s
  end

@[derive has_reflect]
structure safe_rule_config :=
(penalty : option ℤ := none)
(builder : option builder_clause := none)
(safety : option safety_clause := none)

namespace safe_rule_config

meta def add_clause (conf : safe_rule_config) :
  rule_clause → exceptional safe_rule_config
| (rule_clause.builder c) :=
  if conf.builder.is_some
    then exceptional.fail "Duplicate builder clause not allowed."
    else pure { builder := c, ..conf }
| (rule_clause.safety c) :=
  if conf.safety.is_some
    then exceptional.fail "Duplicate safety clause not allowed."
    else pure { safety := c, ..conf }

meta def add_clauses (clauses : list rule_clause)
  (conf : safe_rule_config) : exceptional safe_rule_config :=
clauses.mfoldl add_clause conf

meta def parser : lean.parser safe_rule_config :=
with_desc "penalty (clause)..." $ do
  penalty ← optional small_int,
  clauses ← many rule_clause.parser,
  let init : safe_rule_config := { penalty := penalty },
  init.add_clauses clauses

end safe_rule_config

meta def safe_declaration_to_rule (decl : name) (conf : safe_rule_config) :
  tactic rule_set_member := do
  env ← get_env,
  d ← env.get decl,
  let penalty := conf.penalty.get_or_else 0,
  let safety :=
    (safety_clause.to_safety <$> conf.safety).get_or_else safety.safe,
  let builder :=
    (builder_clause.to_rule_builder <$> conf.builder).get_or_else
      rule_builder.safe_default,
  r ← builder d,
  match r with
  | rule_builder_output.rule r imode :=
    pure $ rule_set_member.safe_rule
      { penalty := penalty,
        safety := safety,
        ..r }
      imode
  | rule_builder_output.simp_lemmas _ :=
    fail! "aesop/safe_declaration_to_rule: internal error: unexpected rule builder output"
  end

@[derive has_reflect]
structure unsafe_rule_config :=
(success_probability : percent)
(builder : option builder_clause := none)

namespace unsafe_rule_config

meta def add_clause (conf : unsafe_rule_config) :
  rule_clause → exceptional unsafe_rule_config
| (rule_clause.builder c) :=
  if conf.builder.is_some
    then exceptional.fail "Duplicate builder clause not allowed."
    else pure { builder := some c, ..conf }
| (rule_clause.safety c) := exceptional.fail
  "Safety clause not allowed for unsafe rules."

meta def add_clauses (clauses : list rule_clause)
  (conf : unsafe_rule_config) : exceptional unsafe_rule_config :=
clauses.mfoldl add_clause conf

meta def parser : lean.parser unsafe_rule_config :=
with_desc "probability (clause)..." $ do
  success_probability ← percent.parser,
  clauses ← many rule_clause.parser,
  let init : unsafe_rule_config := { success_probability := success_probability },
  init.add_clauses clauses

end unsafe_rule_config

meta def unsafe_declaration_to_rule (decl : name) (conf : unsafe_rule_config) :
  tactic rule_set_member := do
  env ← get_env,
  d ← env.get decl,
  let builder :=
    (builder_clause.to_rule_builder <$> conf.builder).get_or_else
      rule_builder.unsafe_default,
  r ← builder d,
  match r with
  | rule_builder_output.rule r imode :=
    pure $ rule_set_member.unsafe_rule
      { success_probability := conf.success_probability, ..r }
      imode
  | rule_builder_output.simp_lemmas _ :=
    fail! "aesop/unsafe_declaration_to_rule: internal error: unexpected rule builder output"
  end

/-! ## Attribute -/

@[derive has_reflect]
inductive rule_config : Type
| normalization (c : normalization_rule_config)
| unsafe (c : unsafe_rule_config)
| safe (c : safe_rule_config)

meta def declaration_to_rule (decl : name) :
  rule_config → tactic rule_set_member
| (rule_config.normalization c) := normalization_declaration_to_rule decl c
| (rule_config.unsafe c) := unsafe_declaration_to_rule decl c
| (rule_config.safe c) := safe_declaration_to_rule decl c

meta def declarations_to_rule_set (decls : list (name × rule_config)) :
  tactic rule_set := do
  rs ← rule_set.from_list <$> decls.mmap (function.uncurry declaration_to_rule),
  default_simp_lemmas ← simp_lemmas.mk_default,
  let rs :=
    { normalization_simp_lemmas :=
        rs.normalization_simp_lemmas.join default_simp_lemmas,
      ..rs },
  pure rs

meta def attr_config_parser : lean.parser rule_config :=
with_desc "[norm | safe | unsafe] rule_config" $ do
  rule_type ← optional ident,
  match rule_type with
  | some `norm   := rule_config.normalization <$> normalization_rule_config.parser
  | some `safe   := rule_config.safe <$> safe_rule_config.parser
  | some `unsafe := rule_config.unsafe <$> unsafe_rule_config.parser
  | none         := rule_config.unsafe <$> unsafe_rule_config.parser
  | some n       := fail $ format! "Unknown aesop attribute type: {n}"
  end

@[user_attribute]
meta def attr : user_attribute name_set rule_config :=
{ name := `aesop,
  descr := "Registers a definition as a rule for the aesop tactic.",
  cache_cfg := {
    mk_cache := pure ∘ name_set.of_list,
    dependencies := [] },
  parser := attr_config_parser }

meta def attr_declarations_to_rule_set (decls : name_set) : tactic rule_set := do
  rs ← decls.to_list.mmap $ λ decl, do {
    config ← attr.get_param decl,
    pure (decl, config) },
  declarations_to_rule_set rs

meta def registered_rule_set : tactic rule_set :=
attr.get_cache >>= attr_declarations_to_rule_set

/-! ## Tactic Configuration -/

@[derive has_reflect]
inductive config_clause
| additional_rules (rs : list (name × rule_config))

meta def rule_parser {α} (p : lean.parser α) : lean.parser (name × α) :=
prod.mk <$> ident <*> p

meta def rules_parser {α} (p : lean.parser α) : lean.parser (list (name × α)) :=
list_of (rule_parser p)

meta def simple_config_clauses : name_map config_clause :=
native.rb_map.mk _ _

meta def config_clauses : name_map (lean.parser config_clause) :=
native.rb_map.of_list
  [ (`unsafe,
      config_clause.additional_rules <$>
        rules_parser (rule_config.unsafe <$> unsafe_rule_config.parser)),
    (`safe,
      config_clause.additional_rules <$>
        rules_parser (rule_config.safe <$> safe_rule_config.parser)),
    (`norm,
      config_clause.additional_rules <$>
        rules_parser (rule_config.normalization <$> normalization_rule_config.parser)) ]

namespace config_clause

meta def parser : lean.parser config_clause :=
with_desc
  "((unsafe [id probability clause*, ...]) | (safe [id penalty clause*, ...]) | (norm [id penalty clause*, ...]))" $
  clause_parser simple_config_clauses config_clauses

end config_clause

@[derive has_reflect]
meta structure config :=
(additional_rules : list (name × rule_config) := [])

namespace config

meta def add_clause (conf : config) : config_clause → config
| (config_clause.additional_rules rs) :=
  { additional_rules := conf.additional_rules ++ rs ..conf }

meta def of_config_clauses (clauses : list config_clause) : config :=
clauses.foldl add_clause {}

meta def parser : lean.parser config :=
of_config_clauses <$> many config_clause.parser

meta def rule_set (conf : config) : tactic rule_set := do
  default_rules ← registered_rule_set,
  additional_rules ← declarations_to_rule_set conf.additional_rules,
  pure $ default_rules.merge additional_rules

end config

end aesop
end tactic


import automation.model
import automation.rpo_fst_tactic
import Architectural.proofObligations

open LANG PORTS
local infix ` OR `:50 := LANG.disj
local infix ` & `:50 := LANG.conj

meta def delegation : list (expr × expr) := [
    (`(fault_armDeactivated_armController), `(fault_lockingSwitchPosition_LACU)),
    (`(fault_operatorControlLever_LACU), `(fault_operatorControlLever_LAAP)),
    (`(fault_operatorControlLever_LACU), `(fault_operatorControlLever_armController)),
    (`(fault_groundSpeed_LACU), `(fault_groundSpeed_LAAP)),
    (`(fault_LAAPFlow_LAAP), `(fault_LAAPFlow_armController)),
    (`(fault_LAAPActive_LAAP),`(fault_LAAPActive_armController)),
    (`(fault_armPositionAngle1_LACU), `(fault_input1_armPosition)),
    (`(fault_output_armPosition), `(fault_angleSensor_armController)),
    (`(fault_LAAPSetpoint_LACU), `(fault_LAAPSetpoint_LAAP)),
    (`(fault_armFlow_armController), `(fault_PWMFlow_LACU)),
    (`(fault_armPositionAngle2_LACU), `(fault_input2_armPosition)),
    (`(fault_groundSpeed_LACU), `(fault_groundSpeed_armController)),
    (`(fault_LAAPRequest_LACU), `(fault_LAAPRequest_LAAP)),
    (`(fault_output_armPosition), `(fault_angleSensor_LAAP))
  ]

meta def foo' : model_info := { del := delegation, comps := [`(armPosition), `(LAAP), `(armController)]}

-- theorem rpo_snd_lacu : RPO_fst MODEL :=
-- by {solve_rpo_fst_new foo',}

theorem rpo_snd_lacu : RPO_snd MODEL :=
begin

solve_rpo_snd_new foo',
-- all_goals {rw fsadfdsa,
-- split,
-- assumption,
-- rw ← asdff,
-- assumption,},
-- {rw fsadfdsa,
--     split,
--       { -- copied from above
--         apply H1_right_1,},
--       {
--         rw ← asdff,
--         apply H1_right_2,
--       }},
-- {},
  -- {    -- copied from above,
  --       rw [disj_comm_guarded],
  --       apply H1,
  -- },
  -- {
  --   rw fsadfdsa,
  --   split,
  --     { -- copied from above
  --       apply H1_right_2,},
  --     {
  --       rw ← asdff,
  --       apply H1_right_1,
  --     }
  -- },
  -- {
  --   rw fsadfdsa,
  --   split,
  --     { -- copied from above
  --       apply H1_right_2,},
  --     {
  --       rw ← asdff,
  --       apply H1_right_1,
  --     },
  -- },
end


universe u
variables a b c : Type u

meta def trace_example : tactic unit :=
do
  goal ← tactic.target,
  tactic.trace goal

meta def let_example : tactic unit :=
do
  let message := "Hello world!",
  tactic.trace message

#check trace_example
#eval let_example


inductive Foo where
  | mk : Nat → Foo
  | boo : String → Foo

instance : ToString Foo where
  toString o := match o with
    | .mk n => aux1 n
    | .boo s => aux2 s
where
  aux1 (n : Nat) : String :=
    s!".mk {n}"
  aux2 (s : String) : String :=
    s!".boo {s}"

example : toString (Foo.mk 10) = ".mk 10" := rfl


import Mathlib.Data.Real.Basic

/-! # Test transparency level of `Div` field in `DivInvMonoid`

It is desirable that particular `DivInvMonoid`s have their `Div` instance not unfold at `.instance`
transparency level, in the same way that the `Div` field of a generic `DivInvMonoid` does not.

To ensure this, in examples where the `Div` field is defined as `fun a b ↦ a * b⁻¹`, we hide this
under one layer of other function (so for example the `Div` instance for `Rat` is defined to be
`⟨Rat.div⟩`, where `Rat.div` is defined to be `fun a b ↦ a * b⁻¹`).

This file checks that this and similar tricks have had the desired effect:
`with_reducible_and_instances apply mul_le_mul` fails although `apply mul_le_mul` succeeds.
-/

example {a b : α} [LinearOrderedField α] : a / 2 ≤ b / 2 := by
  fail_if_success with_reducible_and_instances apply mul_le_mul -- fails, as desired
  sorry

example {a b : ℚ} : a / 2 ≤ b / 2 := by
  fail_if_success with_reducible_and_instances apply mul_le_mul -- fails, as desired
  apply mul_le_mul
  repeat sorry

example {a b : ℝ} : a / 2 ≤ b / 2 := by
  fail_if_success with_reducible_and_instances apply mul_le_mul -- fails, as desired
  apply mul_le_mul
  repeat sorry


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Scott Morrison

/- The Yoneda embedding, as a functor `yoneda : C ⥤ (Cᵒᵖ ⥤ Type v₁)`,
   along with an instance that it is `fully_faithful`.

   Also the Yoneda lemma, `yoneda_lemma : (yoneda_pairing C) ≅ (yoneda_evaluation C)`. -/

import category_theory.natural_transformation
import category_theory.opposites
import category_theory.types
import category_theory.fully_faithful
import category_theory.natural_isomorphism

namespace category_theory

universes v₁ u₁ u₂ -- declare the `v`'s first; see `category_theory.category` for an explanation

variables {C : Type u₁} [𝒞 : category.{v₁} C]
include 𝒞

def yoneda : C ⥤ (Cᵒᵖ ⥤ Type v₁) :=
{ obj := λ X,
  { obj := λ Y, unop Y ⟶ X,
    map := λ Y Y' f g, f.unop ≫ g,
    map_comp' := λ _ _ _ f g, begin ext1, dsimp at *, erw [category.assoc] end,
    map_id' := λ Y, begin ext1, dsimp at *, erw [category.id_comp] end },
  map := λ X X' f, { app := λ Y g, g ≫ f } }

def coyoneda : Cᵒᵖ ⥤ (C ⥤ Type v₁) :=
{ obj := λ X,
  { obj := λ Y, unop X ⟶ Y,
    map := λ Y Y' f g, g ≫ f,
    map_comp' := λ _ _ _ f g, begin ext1, dsimp at *, erw [category.assoc] end,
    map_id' := λ Y, begin ext1, dsimp at *, erw [category.comp_id] end },
  map := λ X X' f, { app := λ Y g, f.unop ≫ g },
  map_comp' := λ _ _ _ f g, begin ext1, ext1, dsimp at *, erw [category.assoc] end,
  map_id' := λ X, begin ext1, ext1, dsimp at *, erw [category.id_comp] end }

namespace yoneda
@[simp] lemma obj_obj (X : C) (Y : Cᵒᵖ) : (yoneda.obj X).obj Y = (unop Y ⟶ X) := rfl
@[simp] lemma obj_map (X : C) {Y Y' : Cᵒᵖ} (f : Y ⟶ Y') :
  (yoneda.obj X).map f = λ g, f.unop ≫ g := rfl
@[simp] lemma map_app {X X' : C} (f : X ⟶ X') (Y : Cᵒᵖ) :
  (yoneda.map f).app Y = λ g, g ≫ f := rfl

lemma obj_map_id {X Y : C} (f : op X ⟶ op Y) :
  ((@yoneda C _).obj X).map f (𝟙 X) = ((@yoneda C _).map f.unop).app (op Y) (𝟙 Y) :=
by obviously

@[simp] lemma naturality {X Y : C} (α : yoneda.obj X ⟶ yoneda.obj Y)
  {Z Z' : C} (f : Z ⟶ Z') (h : Z' ⟶ X) : f ≫ α.app (op Z') h = α.app (op Z) (f ≫ h) :=
begin erw [functor_to_types.naturality], refl end

instance yoneda_fully_faithful : fully_faithful (@yoneda C _) :=
{ preimage := λ X Y f, (f.app (op X)) (𝟙 X),
  injectivity' := λ X Y f g p,
  begin
    injection p with h,
    convert (congr_fun (congr_fun h (op X)) (𝟙 X)); dsimp; simp,
  end }

/-- Extensionality via Yoneda. The typical usage would be
```
-- Goal is `X ≅ Y`
apply yoneda.ext,
-- Goals are now functions `(Z ⟶ X) → (Z ⟶ Y)`, `(Z ⟶ Y) → (Z ⟶ X)`, and the fact that these
functions are inverses and natural in `Z`.
```
-/
def ext (X Y : C)
  (p : Π {Z : C}, (Z ⟶ X) → (Z ⟶ Y)) (q : Π {Z : C}, (Z ⟶ Y) → (Z ⟶ X))
  (h₁ : Π {Z : C} (f : Z ⟶ X), q (p f) = f) (h₂ : Π {Z : C} (f : Z ⟶ Y), p (q f) = f)
  (n : Π {Z Z' : C} (f : Z' ⟶ Z) (g : Z ⟶ X), p (f ≫ g) = f ≫ p g) : X ≅ Y :=
@preimage_iso _ _ _ _ yoneda _ _ _ _
  (nat_iso.of_components (λ Z, { hom := p, inv := q, }) (by tidy))

-- We need to help typeclass inference with some awkward universe levels here.
instance prod_category_instance_1 : category ((Cᵒᵖ ⥤ Type v₁) × Cᵒᵖ) :=
category_theory.prod.{(max u₁ v₁)  v₁} (Cᵒᵖ ⥤ Type v₁) Cᵒᵖ

instance prod_category_instance_2 : category (Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) :=
category_theory.prod.{v₁ (max u₁ v₁)} Cᵒᵖ (Cᵒᵖ ⥤ Type v₁)

end yoneda

namespace coyoneda
@[simp] lemma obj_obj (X : Cᵒᵖ) (Y : C) : (coyoneda.obj X).obj Y = (unop X ⟶ Y) := rfl
@[simp] lemma obj_map {X' X : C} (f : X' ⟶ X) (Y : Cᵒᵖ) :
  (coyoneda.obj Y).map f = λ g, g ≫ f := rfl
@[simp] lemma map_app (X : C) {Y Y' : Cᵒᵖ} (f : Y ⟶ Y') :
  (coyoneda.map f).app X = λ g, f.unop ≫ g := rfl
end coyoneda

class representable (F : Cᵒᵖ ⥤ Type v₁) :=
(X : C)
(w : yoneda.obj X ≅ F)

variables (C)
open yoneda

def yoneda_evaluation : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type (max u₁ v₁) :=
evaluation_uncurried Cᵒᵖ (Type v₁) ⋙ ulift_functor.{u₁}

@[simp] lemma yoneda_evaluation_map_down
  (P Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (x : (yoneda_evaluation C).obj P) :
  ((yoneda_evaluation C).map α x).down = α.2.app Q.1 (P.2.map α.1 x.down) := rfl

def yoneda_pairing : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁) ⥤ Type (max u₁ v₁) :=
functor.prod yoneda.op (functor.id (Cᵒᵖ ⥤ Type v₁)) ⋙ functor.hom (Cᵒᵖ ⥤ Type v₁)

@[simp] lemma yoneda_pairing_map
  (P Q : Cᵒᵖ × (Cᵒᵖ ⥤ Type v₁)) (α : P ⟶ Q) (β : (yoneda_pairing C).obj P) :
  (yoneda_pairing C).map α β = yoneda.map α.1.unop ≫ β ≫ α.2 := rfl

def yoneda_lemma : yoneda_pairing C ≅ yoneda_evaluation C :=
{ hom :=
  { app := λ F x, ulift.up ((x.app F.1) (𝟙 (unop F.1))),
    naturality' :=
    begin
      intros X Y f, ext1, ext1,
      cases f, cases Y, cases X,
      dsimp at *, simp at *,
      erw [←functor_to_types.naturality,
           obj_map_id,
           functor_to_types.naturality,
           functor_to_types.map_id]
    end },
  inv :=
  { app := λ F x,
    { app := λ X a, (F.2.map a.op) x.down,
      naturality' :=
      begin
        intros X Y f, ext1,
        cases x, cases F,
        dsimp at *,
        erw [functor_to_types.map_comp]
      end },
    naturality' :=
    begin
      intros X Y f, ext1, ext1, ext1,
      cases x, cases f, cases Y, cases X,
      dsimp at *,
      erw [←functor_to_types.naturality, functor_to_types.map_comp]
    end },
  hom_inv_id' :=
  begin
    ext1, ext1, ext1, ext1, cases X, dsimp at *,
    erw [←functor_to_types.naturality,
         obj_map_id,
         functor_to_types.naturality,
         functor_to_types.map_id], refl,
  end,
  inv_hom_id' :=
  begin
    ext1, ext1, ext1,
    cases x, cases X,
    dsimp at *,
    erw [functor_to_types.map_id]
  end }.

variables {C}

@[simp] def yoneda_sections (X : C) (F : Cᵒᵖ ⥤ Type v₁) : (yoneda.obj X ⟹ F) ≅ ulift.{u₁} (F.obj (op X)) :=
nat_iso.app (yoneda_lemma C) (op X, F)

omit 𝒞
@[simp] def yoneda_sections_small {C : Type u₁} [small_category C] (X : C) (F : Cᵒᵖ ⥤ Type u₁) : (yoneda.obj X ⟹ F) ≅ F.obj (op X) :=
yoneda_sections X F ≪≫ ulift_trivial _

end category_theory


import tactic.core

attribute [inline] or.decidable decidable.to_bool bool.decidable_eq and.decidable
  nat.decidable_eq ne.decidable decidable.false implies.decidable option.get_or_else
  option.map

meta def format.form (as : list format) : format :=
(format.join (as.intersperse format.line)).paren.group

open native

meta def expr.meta_vars (e : expr) : rb_set expr :=
e.fold mk_rb_set $ λ e i ms,
match e with
| expr.mvar _ _ _ := ms.insert e
| _ := ms
end

meta def list.dup_by_native {α β} [has_lt β] [decidable_rel ((<) : β → β → Prop)]
  (f : α → β) (xs : list α) : list α :=
rb_map.values $ xs.foldl (λ m x, m.insert (f x) x) mk_rb_map

meta def level.mvar_name : level → name
| (level.mvar n) := n
| _ := name.anonymous

private meta def level.meta_vars_core : level → name_set → name_set
| level.zero := id
| (level.param _) := id
| (level.succ l) := l.meta_vars_core
| (level.mvar n) := λ ms, ms.insert n
| (level.max a b) := a.meta_vars_core ∘ b.meta_vars_core
| (level.imax a b) := a.meta_vars_core ∘ b.meta_vars_core

meta def level.meta_vars (l : level) : name_set :=
level.meta_vars_core l mk_name_set

meta def expr.univ_meta_vars (e : expr) : name_set :=
e.fold mk_name_set $ λ e i ms,
match e with
| expr.sort l := level.meta_vars_core l ms
| expr.const _ ls := ls.foldr level.meta_vars_core ms
| _ := ms
end

def list.index_of_core' {α} [decidable_eq α] (a : α) : ℕ → list α → option ℕ
| i [] := none
| i (x::xs) := if x = a then some i else xs.index_of_core' (i+1)

def list.index_of' {α} [decidable_eq α] (a : α) (xs : list α) : option ℕ :=
xs.index_of_core' a 0

meta def expr.abstract_mvars (e : expr) (mvars : list name) : expr :=
e.replace $ λ e i,
match e with
| e@(expr.mvar n _ _) :=
  (mvars.index_of' n).map (λ j, expr.var (i + j))
| e := none
end

meta def expr.meta_uniq_name : expr → name
| (expr.mvar n _ _) := n
| _ := name.anonymous

meta def expr.meta_type : expr → expr
| (expr.mvar _ _ t) := t
| _ := default _

meta def expr.abstract_mvars' (e : expr) (mvars : list expr) : expr :=
e.abstract_mvars (mvars.map expr.meta_uniq_name)

open tactic

private meta def sorted_mvars_core : list expr → list expr → tactic (list expr)
| (e@(expr.mvar n pp_n _)::es) ctx :=
  if ∃ m ∈ ctx, (m : expr).meta_uniq_name = e.meta_uniq_name then
    sorted_mvars_core es ctx
  else do
    t ← infer_type e >>= instantiate_mvars,
    ctx ← sorted_mvars_core t.meta_vars.to_list ctx,
    sorted_mvars_core es (e :: ctx)
| [] ctx := pure ctx
| (e::es) ctx := sorted_mvars_core (e.meta_vars.to_list ++ es) ctx

meta def expr.sorted_mvars' (es : list expr) : tactic (list expr) :=
sorted_mvars_core es []

meta def expr.sorted_mvars (e : expr) : tactic (list expr) :=
expr.sorted_mvars' [e]

meta def abstract_mvar_telescope : list expr → tactic (list expr)
| [] := pure []
| (m :: ms) := do
  t ← infer_type m >>= instantiate_mvars,
  ms' ← abstract_mvar_telescope ms,
  pure $ t.abstract_mvars' ms :: ms'

meta def level.instantiate_univ_mvars (subst : rb_map name level) : level → level
| level.zero := level.zero
| (level.succ a) := a.instantiate_univ_mvars.succ
| (level.max a b) := level.max (a.instantiate_univ_mvars) (b.instantiate_univ_mvars)
| (level.imax a b) := level.imax (a.instantiate_univ_mvars) (b.instantiate_univ_mvars)
| l@(level.param _) := l
| l@(level.mvar n) := (subst.find n).get_or_else l

meta def expr.instantiate_univ_mvars (subst : rb_map name level) (e : expr) : expr :=
e.replace $ λ e i,
match e with
| (expr.const n ls) :=
  some $ expr.const n (ls.map (level.instantiate_univ_mvars subst))
| (expr.sort l) :=
  some $ expr.sort (l.instantiate_univ_mvars subst)
| _ := none
end

meta def expr.mk_lambda (x e : expr) : expr :=
expr.lam x.local_pp_name x.local_binding_info x.local_type (e.abstract x)

meta def expr.mk_lambdas (xs : list expr) (e : expr) : expr :=
xs.foldr expr.mk_lambda e

meta def expr.mk_pi (x e : expr) : expr :=
expr.pi x.local_pp_name x.local_binding_info x.local_type (e.abstract x)

meta def expr.mk_pis (xs : list expr) (e : expr) : expr :=
xs.foldr expr.mk_pi e

meta def expr.app' : expr → expr → expr
| (expr.lam _ _ _ a) b := a.instantiate_var b
| a b := a b

lemma or_imp_congr {p p' q q'} (hp : p → p') (hq : q → q') : p ∨ q → p' ∨ q'
| (or.inl h) := or.inl (hp h)
| (or.inr h) := or.inr (hq h)

lemma or_imp_congr_left {p q r} (h : q → r) : q ∨ p → r ∨ p :=
or_imp_congr h id

lemma or_imp_congr_right {p q r} (h : q → r) : p ∨ q → p ∨ r :=
or_imp_congr id h

lemma or_imp_congr_right_strong {p q r} (h : ¬ p → q → r) : p ∨ q → p ∨ r :=
match classical.prop_decidable p with
| decidable.is_true hp := λ _, or.inl hp
| decidable.is_false hp := or_imp_congr_right (h hp)
end

lemma imp_iff_or_not {p q : Prop} : (p → q) ↔ (¬ p ∨ q) :=
by cases classical.prop_decidable p; simp *

lemma not_imp_iff_or {p q : Prop} : (¬ p → q) ↔ (p ∨ q) :=
by cases classical.prop_decidable p; simp *

theorem iff_imp {a b c} : ((a ↔ b) → c) ↔ ((a → b) → (b → a) → c) :=
iff.intro (λ h ha hb, h ⟨ha, hb⟩) (λ h ⟨ha, hb⟩, h ha hb)

lemma classical.forall_imp_iff_exists_not_or {α} {p : α → Prop} {q : Prop} :
  ((∀ x, p x) → q) ↔ ((∃ x, ¬ p x) ∨ q) :=
by simp [imp_iff_or_not]

def list.has_dups_core {α} [decidable_eq α] : list α → list α → bool
| (x::xs) ys := x ∈ ys ∨ xs.has_dups_core (x::ys)
| [] _ := ff

def list.has_dups {α} [decidable_eq α] (xs : list α) : bool :=
xs.has_dups_core []

def list.zip_with_index_core {α} : ℕ → list α → list (α × ℕ)
| _ [] := []
| i (x::xs) := (x,i) :: list.zip_with_index_core (i+1) xs

def list.zip_with_index {α} : list α → list (α × ℕ) :=
list.zip_with_index_core 0

def list.filter_maximal {α} (gt : α → α → bool) (l : list α) : list α :=
l.filter $ λ x, ∀ y ∈ l, ¬ gt y x

def list.m_any {α m} [monad m] (f : α → m bool) : list α → m bool
| [] := pure ff
| (x::xs) := do f_x ← f x, if f_x then pure tt else xs.m_any

meta def mk_metas_core : list expr → tactic (list expr)
| [] := pure []
| (t::ts) := do
  ms ← mk_metas_core ts,
  m ← mk_meta_var (t.instantiate_vars ms),
  pure (m::ms)

meta def expr.name_hint : expr → option name
| (expr.const n _) := n
| (expr.app a b) := a.name_hint <|> b.name_hint
| (expr.pi pp_n _ a b) := b.name_hint <|> a.name_hint <|> pp_n
| (expr.lam pp_n _ a b) := b.name_hint <|> pp_n
| (expr.sort _) := `type
| (expr.local_const _ pp_n _ _) := pp_n
| _ := name.anonymous

meta def expr.hyp_name_hint (e : expr) : name :=
match e.name_hint with
| some (name.mk_string s _) := ("h_" ++ s : string)
| _ := `h
end

meta def mk_locals_core : list expr → tactic (list expr)
| [] := pure []
| (t::ts) := do
  lcs ← mk_locals_core ts,
  lc ← mk_local' t.hyp_name_hint binder_info.default (t.instantiate_vars lcs),
  pure (lc :: lcs)

meta def expr.const_levels : expr → list level
| (expr.const n ls) := ls
| _ := []

@[inline] instance has_monad_lift.refl {m} [monad m] : has_monad_lift m m := ⟨λ _, id⟩

meta def tactic.unify_level (l1 l2 : level) : tactic unit :=
tactic.unify (expr.sort l1) (expr.sort l2)

namespace tactic

meta def unify_with_type (a b : expr) (trnsp := transparency.semireducible) (approx := ff) :
  tactic unit := do
ta ← infer_type a,
tb ← infer_type b,
unify ta tb trnsp approx,
unify a b trnsp approx

meta def minimal_tc_failure : expr → tactic expr | e := do
ff ← succeeds (type_check e),
match e with
| (expr.app a b) := minimal_tc_failure a <|> minimal_tc_failure b
| (expr.lam n bi a b) :=
  minimal_tc_failure a <|> (do
    l ← mk_local' n bi a,
    minimal_tc_failure (b.instantiate_var a))
| (expr.pi n bi a b) :=
  minimal_tc_failure a <|> (do
    l ← mk_local' n bi a,
    minimal_tc_failure (b.instantiate_var a))
| (expr.elet n t v b) :=
  minimal_tc_failure t <|> minimal_tc_failure v <|>
    minimal_tc_failure (b.instantiate_var v)
| e := pure e
end <|> pure e

end tactic

-- decidable instance for bounded existence is not short-circuiting?!?
def list.existsb {α} (p : α → bool) : list α → bool
| [] := ff
| (x :: xs) := if p x then tt else xs.existsb

meta def infer_univ (type : expr) : tactic level := do
sort_of_type ← infer_type type >>= whnf,
match sort_of_type with
| expr.sort lvl := pure lvl
| not_sort := do
  fmt ← pp not_sort,
  fail $ (to_fmt "cannot get universe level of sort:" ++ format.line ++ fmt).group.nest 1
end


macro "A" : term => `(id x)
theorem test : A = A := sorry


import tactic.derive_fintype
import logic.function.basic
import data.set.function
import data.fin.tuple
import data.finset.lattice

section vars
@[derive decidable_eq, derive fintype, derive inhabited]
inductive Vars
| i | j | k | w | x | y | z | ind₀ | ind₁ | ind₂ | break | output | len | vals

open Vars
instance : has_to_string Vars :=
⟨λ v, match v with
-- S.split(" | ").map(s => s + ' := "' + s + '"')
| i := "i" | j := "j" | k := "k" | w := "w" | x := "x" | y := "y" | z := "z" | ind₀ := "ind₀" | ind₁ := "ind₁" | ind₂ := "ind₂" | break := "break" | output := "output" | len := "len" | vals := "vals"
end⟩
end vars

section NameSpace
@[derive decidable_eq, derive inhabited, derive has_to_string, reducible]
def NameSpace := ℕ

def NameSpace.reserved : NameSpace := 0

def fresh (S : finset NameSpace) : NameSpace :=
S.max.iget + 1

theorem not_fresh_mem (S : finset NameSpace) : fresh S ∉ S :=
begin
  simp only [fresh],
  cases hn : S.max,
  { rw finset.max_eq_bot.1 hn, exact finset.not_mem_empty _, },
  { refine finset.not_mem_of_max_lt _ hn, simp },
end

theorem not_fresh_reserved (S : finset NameSpace) : fresh S ≠ NameSpace.reserved :=
by simp [fresh, NameSpace.reserved]

attribute [irreducible] NameSpace
end NameSpace

@[derive decidable_eq, derive fintype, derive inhabited]
inductive Types
| nn | rr | bb

section Ident

@[derive decidable_eq]
structure Ident (b : Types) :=
(ns : NameSpace)
(name : Vars)

instance {b : Types} : has_to_string (Ident b) :=
⟨λ i, "n" ++ (to_string i.ns) ++ "_" ++ (to_string i.name)⟩

lemma Ident_ns_surjective {b : Types} : function.surjective (@Ident.ns b) :=
by { intro x, use ⟨x, default⟩, }

@[simp] lemma Ident_ns_range {b : Types} : set.range (@Ident.ns b) = set.univ :=
by simpa [set.surjective_iff_surj_on_univ, set.surj_on, set.univ_subset_iff] using Ident_ns_surjective

infix `∷`:9000 := Ident.mk
infix `∷ₙ`:9000 := @Ident.mk Types.nn
infix `∷ᵣ`:9000 := @Ident.mk Types.rr

end Ident

section frames
-- TODO Fix
variables {α γ : Type*} {β : α → Type*} (f : (Π x, β x) → γ) (g : (Π x, β x) → (Π x, β x))

def function.has_dframe (S : set α) : Prop :=
∀ ⦃c₁ c₂ : Π x, β x⦄, (∀ x ∈ S, c₁ x = c₂ x) → f c₁ = f c₂

structure function.has_dheap (S : set α) : Prop :=
(local_frame : ∀ (c₁ c₂ : Π x, β x), (∀ x ∈ S, c₁ x = c₂ x) → ∀ {y}, y ∈ S → g c₁ y = g c₂ y)
(global_id : ∀ (c y), y ∉ S → g c y = c y)

variables {f g}
theorem function.has_dframe.res {S} (h : function.has_dframe f S) (S') (hS' : S ⊆ S') :
  function.has_dframe f S' :=
λ c₁ c₂ h', h (λ x hx, h' _ (hS' hx))

theorem function.has_dheap.res {S} (h : function.has_dheap g S) (S') (hS' : S ⊆ S') :
  function.has_dheap g S' :=
{ local_frame := λ c₁ c₂ c_eq y hy,
begin
  by_cases H : y ∈ S,
  { exact h.local_frame c₁ c₂ (λ x hx, c_eq _ (hS' hx)) H, },
  { rw [h.global_id c₁ _ H, h.global_id c₂ _ H],  exact c_eq _ hy, },
end,
  global_id := λ c y hy, h.global_id c y (λ H, hy (hS' H)), }

theorem function.has_dframe.const (x : γ) (S : set α) : function.has_dframe (λ _ : Π x, β x, x) S :=
λ _ _ _, rfl

theorem function.has_dheap.id (S : set α) : function.has_dheap (@id (Π x, β x)) S :=
{ local_frame := λ c₁ c₂ h y hy, h y hy,
  global_id := λ _ _ _, rfl }

example {S : set α} {x₀ : α} {y₀ : β x₀} [∀ x, decidable_eq (β x)] (f : (Π x, β x) → (Π x, β x)) (g : (Π x, β x) → γ)
  (hf : function.has_dframe g S) (hg : function.has_dheap f (insert x₀ S)) :
  function.has_dframe (λ ctx, if ctx x₀ = y₀ then g (f ctx) else g ctx) (insert x₀ S) :=
begin
  intros c₁ c₂ c_eq, dsimp only,
  have := (hf.res _ _) c_eq,
  all_goals { sorry, },
end

end frames

def Context (val_type : Types → Type) : Type :=
∀ ⦃b : Types⦄, Ident b → val_type b

structure HeapContext (val_type : Types → Type) : Type :=
(store : Context val_type)
(heap : Context (list ∘ val_type))

namespace Context

variable {val_type : Types → Type}

instance [∀ b, inhabited (val_type b)] : inhabited (Context val_type) :=
⟨λ _ _, default⟩

def get (ctx : Context val_type) {b : Types} (x : Ident b) : val_type b := ctx x

def update (ctx : Context val_type) {b : Types} (x : Ident b) (v : val_type b) :
  Context val_type :=
function.update ctx b (function.update (@ctx b) x v)

/- Spec for context -/
@[simp] lemma update_sound (ctx : Context val_type) {b : Types} (x : Ident b) (v : val_type b) :
  (ctx.update x v).get x = v := by simp [update, get]

@[simp] lemma update_frame (ctx : Context val_type) {b : Types} (x y : Ident b) (vx : val_type b)
  (neq : y ≠ x) : (ctx.update x vx).get y = ctx.get y := by simp [get, update, function.update, neq]

/- TODO: Add simp lemmas -/

/- For some reason doesn't play well with equation compiler -/
-- attribute [irreducible] Context

-- @[simp]
-- def try_modify (ctx : Context val_type) {b : Types} (x : Ident b) (f : val_type b → option (val_type b)) :
--   option (Context val_type) :=
-- (f (ctx.get x)).map (ctx.update x)

end Context

namespace HeapContext
variable {val_type : Types → Type}

@[simps] def update (ctx : HeapContext val_type) {b : Types} (x : Ident b) (v : val_type b) :
  HeapContext val_type :=
{ store := ctx.store.update x v,
  heap := ctx.heap }

@[simps] def update_arr (ctx : HeapContext val_type) {b : Types} (x : Ident b)
  (n : ℕ) (v : val_type b) : HeapContext val_type :=
{ store := ctx.store,
  heap := ctx.heap.update x ((ctx.heap.get x).update_nth n v) }

end HeapContext

section iterate

@[simp]
def iterate_while {α : Type*} (f : α → option α) (cond : α → option bool) : ℕ → α → option α
| 0 x := none
| (n+1) x := (cond x).bind (λ b, if b then (f x).bind (iterate_while n) else some x)

-- theorem iterate_while_tr {α β : Type*} {f₁ : α → option α} {cond₁ : α → option bool} {n : ℕ} {x : α}
--   (tr : α → β) (f₂ : β → option β) (cond₂ : β → option bool) (y : β)
--   (hf : ∀ x, )

-- theorem iterate_while_eq_of_invariant {α : Type*} (inv : α → ℕ → Prop)
--   (f : α → option α) (cond : α → option bool) (n : ℕ) (x : α)
--   (hcond : ∀ {x i}, inv x i → (cond x).is_some)
--   (h₀ : inv x 0) (hind : ∀ x i, cond x = some tt → inv x i → ∃ x' ∈ f x, inv x' (i + 1))
--   (hₜ : ∀ {x}, inv x n → cond x = some ff) :
--   ∃ r ∈ iterate_while f cond (n + 1) x, inv r n :=
-- begin
--   induction n with n ih generalizing x,
--   { simpa [hₜ h₀], },
--   obtain ⟨_|_, hc⟩ := option.is_some_iff_exists.mp (hcond h₀),
--   { simp, }
-- end

end iterate

theorem imp_iff_distrib {a b c : Prop} : ((a → b) ↔ (a → c)) ↔ (a → (b ↔ c)) :=
⟨λ h ha, ⟨λ hb, h.mp (λ _, hb) ha, λ hc, h.mpr (λ _, hc) ha⟩, λ h, ⟨λ hb ha, (h ha).mp (hb ha), λ hc ha, (h ha).mpr (hc ha)⟩⟩


import Duper.MClause
import Duper.RuleM
import Duper.Simp
import Duper.Util.ProofReconstruction

namespace Duper
open Lean
open Meta
open RuleM
open SimpResult

initialize Lean.registerTraceClass `Rule.eqHoist

theorem eq_hoist_proof (x y : α) (f : Prop → Prop) (h : f (x = y)) : f False ∨ x = y := by
  by_cases x_eq_y : x = y
  . exact Or.inr x_eq_y
  . rename ¬x = y => x_ne_y
    have x_eq_y_false := eq_false x_ne_y
    exact Or.inl $ x_eq_y_false ▸ h

def mkEqHoistProof (pos : ClausePos) (freshVar1 freshVar2 : Expr) (premises : List Expr)
  (parents : List ProofParent) (transferExprs : Array Expr) (c : Clause) : MetaM Expr :=
  Meta.forallTelescope c.toForallExpr fun xs body => do
    let cLits := c.lits.map (fun l => l.map (fun e => e.instantiateRev xs))
    let (parentsLits, appliedPremises, transferExprs) ← instantiatePremises parents premises xs transferExprs
    let parentLits := parentsLits[0]!
    let appliedPremise := appliedPremises[0]!

    let mut caseProofs := Array.mkEmpty parentLits.size
    for i in [:parentLits.size] do
      let lit := parentLits[i]!
      let pr : Expr ← Meta.withLocalDeclD `h lit.toExpr fun h => do
        if i == pos.lit then
          let substLitPos : LitPos := ⟨pos.side, pos.pos⟩
          let abstrLit ← (lit.abstractAtPos! substLitPos)
          let abstrExp := abstrLit.toExpr
          let abstrLam := mkLambda `x BinderInfo.default (mkSort levelZero) abstrExp
          let lastTwoClausesProof ← Meta.mkAppM ``eq_hoist_proof #[freshVar1, freshVar2, abstrLam, h]
          Meta.mkLambdaFVars #[h] $ ← orSubclause (cLits.map Lit.toExpr) 2 lastTwoClausesProof
        else
          let idx := if i ≥ pos.lit then i - 1 else i
          Meta.mkLambdaFVars #[h] $ ← orIntro (cLits.map Lit.toExpr) idx h
      caseProofs := caseProofs.push pr
    let r ← orCases (parentLits.map Lit.toExpr) caseProofs
    Meta.mkLambdaFVars xs $ mkApp r appliedPremise

def eqHoistAtExpr (e : Expr) (pos : ClausePos) (given : Clause) (c : MClause) : RuleM (Array ClauseStream) :=
  withoutModifyingMCtx do
    let lit := c.lits[pos.lit]!
    if e.getTopSymbol.isMVar then -- Check condition 4
      -- If the head of e is a variable then it must be applied and the affected literal must be either
      -- e = True, e = False, or e = e' where e' is another variable headed term
      if not e.isApp then -- e is a non-applied variable and so we cannot apply eqHoist
        return #[]
      if pos.pos != #[] then
        return #[] -- e is not at the top level so the affected literal cannot have the form e = ...
      if not lit.sign then
        return #[] -- The affected literal is not positive and so it cannot have the form e = ...
      let otherSide := lit.getOtherSide pos.side
      if otherSide != (mkConst ``True) && otherSide != (mkConst ``False) && not otherSide.getTopSymbol.isMVar then
        return #[] -- The other side is not True, False, or variable headed, so the affected literal cannot have the required form
    -- Check conditions 1 and 3 (condition 2 is guaranteed by construction)
    let eligibility ← eligibilityPreUnificationCheck c pos.lit
    if eligibility == Eligibility.notEligible then
      return #[]
    -- Make freshVars and freshVarEquality
    let freshVar1 ← mkFreshExprMVar none
    let freshVarTy ← inferType freshVar1
    let freshVar2 ← mkFreshExprMVar freshVarTy
    let freshVarEquality ← mkAppM ``Eq #[freshVar1, freshVar2]
    -- Perform unification
    let ug ← unifierGenerator #[(e, freshVarEquality)]
    let loaded ← getLoadedClauses
    let yC := do
      setLoadedClauses loaded
      if not $ ← eligibilityPostUnificationCheck c pos.lit eligibility (strict := lit.sign) then
        return none
      let eSide ← instantiateMVars $ lit.getSide pos.side
      let otherSide ← instantiateMVars $ lit.getOtherSide pos.side
      let cmp ← compare eSide otherSide
      if cmp == Comparison.LessThan || cmp == Comparison.Equal then -- If eSide ≤ otherSide then e is not in an eligible position
        return none
      -- All side conditions have been met. Yield the appropriate clause
      let cErased := c.eraseLit pos.lit
      -- Need to instantiate mvars in freshVar1, freshVar2, and freshVarEquality because unification assigned to mvars in each of them
      let freshVar1 ← instantiateMVars freshVar1
      let freshVar2 ← instantiateMVars freshVar2
      let freshVarEquality ← instantiateMVars freshVarEquality
      let newClause := cErased.appendLits #[← lit.replaceAtPos! ⟨pos.side, pos.pos⟩ (mkConst ``False), Lit.fromExpr freshVarEquality]
      trace[Rule.eqHoist] "Created {newClause.lits} from {c.lits}"
      yieldClause newClause "eqHoist" $ some (mkEqHoistProof pos freshVar1 freshVar2)
    return #[ClauseStream.mk ug given yC "eqHoist"]

def eqHoist (given : Clause) (c : MClause) (cNum : Nat) : RuleM (Array ClauseStream) := do
  trace[Rule.eqHoist] "Running EqHoist on {c.lits}"
  let fold_fn := fun streams e pos => do
    let str ← eqHoistAtExpr e.consumeMData pos given c
    return streams.append str
  c.foldGreenM fold_fn #[]


/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Data.Options

/-! # Basic support for auto bound implicit local names -/

namespace Lean.Elab

register_builtin_option autoImplicit : Bool := {
    defValue := true
    descr    := "Unbound local variables in declaration headers become implicit arguments. In \"relaxed\" mode (default), any atomic identifier is eligible, otherwise only a lower case or greek letter followed by numeric digits are eligible. For example, `def f (x : Vector α n) : Vector α n :=` automatically introduces the implicit variables {α n}."
  }

register_builtin_option relaxedAutoImplicit : Bool := {
    defValue := true
    descr    := "When \"relaxed\" mode is enabled, any atomic nonempty identifier is eligible for auto bound implicit locals (see optin `autoBoundImplicitLocal`."
  }

private def isValidAutoBoundSuffix (s : String) : Bool :=
  s.toSubstring.drop 1 |>.all fun c => c.isDigit || isSubScriptAlnum c || c == '_' || c == '\''

/-!
Remark: Issue #255 exposed a nasty interaction between macro scopes and auto-bound-implicit names.
```
local notation "A" => id x
theorem test : A = A := sorry
```
We used to use `n.eraseMacroScopes` at `isValidAutoBoundImplicitName` and `isValidAutoBoundLevelName`.
Thus, in the example above, when `A` is expanded, a `x` with a fresh macro scope is created.
`x`+macros-scope is not in scope and is a valid auto-bound implicit name after macro scopes are erased.
So, an auto-bound exception would be thrown, and `x`+macro-scope would be added as a new implicit.
When, we try again, a `x` with a new macro scope is created and this process keeps repeating.
Therefore, we do consider identifier with macro scopes anymore.
-/

def isValidAutoBoundImplicitName (n : Name) (relaxed : Bool) : Bool :=
  match n with
  | .str .anonymous s => s.length > 0 && (relaxed || ((isGreek s.front || s.front.isLower) && isValidAutoBoundSuffix s))
  | _ => false

def isValidAutoBoundLevelName (n : Name) (relaxed : Bool) : Bool :=
  match n with
  | .str .anonymous s => s.length > 0 && (relaxed || (s.front.isLower && isValidAutoBoundSuffix s))
  | _ => false

end Lean.Elab


/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import tactic.fix_reflect_string

/-!
# Documentation commands

We generate html documentation from mathlib. It is convenient to collect lists of tactics, commands,
notes, etc. To facilitate this, we declare these documentation entries in the library
using special commands.

* `library_note` adds a note describing a certain feature or design decision. These can be
  referenced in doc strings with the text `note [name of note]`.
* `add_tactic_doc` adds an entry documenting an interactive tactic, command, hole command, or
  attribute.

Since these commands are used in files imported by `tactic.core`, this file has no imports.

## Implementation details

`library_note note_id note_msg` creates a declaration `` `library_note.i `` for some `i`.
This declaration is a pair of strings `note_id` and `note_msg`, and it gets tagged with the
`library_note` attribute.

Similarly, `add_tactic_doc` creates a declaration `` `tactic_doc.i `` that stores the provided
information.
-/

/-- A rudimentary hash function on strings. -/
def string.hash (s : string) : ℕ :=
s.fold 1 (λ h c, (33*h + c.val) % unsigned_sz)

/-- `mk_hashed_name nspace id` hashes the string `id` to a value `i` and returns the name
`nspace._i` -/
meta def string.mk_hashed_name (nspace : name) (id : string) : name :=
nspace <.> ("_" ++ to_string id.hash)

open tactic

/--
`copy_doc_string fr to` copies the docstring from the declaration named `fr`
to each declaration named in the list `to`. -/
meta def tactic.copy_doc_string (fr : name) (to : list name) : tactic unit :=
do fr_ds ← doc_string fr,
   to.mmap' $ λ tgt, add_doc_string tgt fr_ds

open lean lean.parser interactive

/--
`copy_doc_string source → target_1 target_2 ... target_n` copies the doc string of the
declaration named `source` to each of `target_1`, `target_2`, ..., `target_n`.
 -/
@[user_command] meta def copy_doc_string_cmd
  (_ : parse (tk "copy_doc_string")) : parser unit :=
do fr ← parser.ident,
   tk "->",
   to ← parser.many parser.ident,
   expr.const fr _  ← resolve_name fr,
   to ← parser.of_tactic (to.mmap $ λ n, expr.const_name <$> resolve_name n),
   tactic.copy_doc_string fr to

/-! ### The `library_note` command -/

/-- A user attribute `library_note` for tagging decls of type `string × string` for use in note
output. -/
@[user_attribute] meta def library_note_attr : user_attribute :=
{ name := `library_note,
  descr := "Notes about library features to be included in documentation" }

/--
`mk_reflected_definition name val` constructs a definition declaration by reflection.

Example: ``mk_reflected_definition `foo 17`` constructs the definition
declaration corresponding to `def foo : ℕ := 17`
-/
meta def mk_reflected_definition (decl_name : name) {type} [reflected type]
  (body : type) [reflected body] : declaration :=
mk_definition decl_name (reflect type).collect_univ_params (reflect type) (reflect body)

/-- If `note_name` and `note` are `pexpr`s representing strings,
`add_library_note note_name note` adds a declaration of type `string × string` and tags it with
the `library_note` attribute. -/
meta def tactic.add_library_note (note_name note : string) : tactic unit :=
do let decl_name := note_name.mk_hashed_name `library_note,
   add_decl $ mk_reflected_definition decl_name (note_name, note),
   library_note_attr.set decl_name () tt none

open tactic

/--
A command to add library notes. Syntax:
```
/--
note message
-/
library_note "note id"
```
-/
@[user_command] meta def library_note (mi : interactive.decl_meta_info)
  (_ : parse (tk "library_note")) : parser unit := do
note_name ← parser.pexpr,
note_name ← eval_pexpr string note_name,
some doc_string ← pure mi.doc_string | fail "library_note requires a doc string",
add_library_note note_name doc_string

/-- Collects all notes in the current environment.
Returns a list of pairs `(note_id, note_content)` -/
meta def tactic.get_library_notes : tactic (list (string × string)) :=
attribute.get_instances `library_note >>=
  list.mmap (λ dcl, mk_const dcl >>= eval_expr (string × string))

/-! ### The `add_tactic_doc_entry` command -/

/-- The categories of tactic doc entry. -/
@[derive [decidable_eq, has_reflect]]
inductive doc_category
| tactic | cmd | hole_cmd | attr

/-- Format a `doc_category` -/
meta def doc_category.to_string : doc_category → string
| doc_category.tactic := "tactic"
| doc_category.cmd := "command"
| doc_category.hole_cmd := "hole_command"
| doc_category.attr := "attribute"

meta instance : has_to_format doc_category := ⟨↑doc_category.to_string⟩

/-- The information used to generate a tactic doc entry -/
@[derive has_reflect]
structure tactic_doc_entry :=
(name : string)
(category : doc_category)
(decl_names : list _root_.name)
(tags : list string := [])
(description : string := "")
(inherit_description_from : option _root_.name := none)

/-- Turns a `tactic_doc_entry` into a JSON representation. -/
meta def tactic_doc_entry.to_json (d : tactic_doc_entry) : json :=
json.object [
  ("name", d.name),
  ("category", d.category.to_string),
  ("decl_names", d.decl_names.map (json.of_string ∘ to_string)),
  ("tags", d.tags.map json.of_string),
  ("description", d.description)
]

meta instance : has_to_string tactic_doc_entry :=
⟨json.unparse ∘ tactic_doc_entry.to_json⟩

/-- `update_description_from tde inh_id` replaces the `description` field of `tde` with the
    doc string of the declaration named `inh_id`. -/
meta def tactic_doc_entry.update_description_from (tde : tactic_doc_entry) (inh_id : name) :
  tactic tactic_doc_entry :=
do ds ← doc_string inh_id <|> fail (to_string inh_id ++ " has no doc string"),
   return { description := ds .. tde }

/--
`update_description tde` replaces the `description` field of `tde` with:

* the doc string of `tde.inherit_description_from`, if this field has a value
* the doc string of the entry in `tde.decl_names`, if this field has length 1

If neither of these conditions are met, it returns `tde`. -/
meta def tactic_doc_entry.update_description (tde : tactic_doc_entry) : tactic tactic_doc_entry :=
match tde.inherit_description_from, tde.decl_names with
| some inh_id, _ := tde.update_description_from inh_id
| none, [inh_id] := tde.update_description_from inh_id
| none, _ := return tde
end

/-- A user attribute `tactic_doc` for tagging decls of type `tactic_doc_entry`
for use in doc output -/
@[user_attribute] meta def tactic_doc_entry_attr : user_attribute :=
{ name := `tactic_doc,
  descr := "Information about a tactic to be included in documentation" }

/-- Collects everything in the environment tagged with the attribute `tactic_doc`. -/
meta def tactic.get_tactic_doc_entries : tactic (list tactic_doc_entry) :=
attribute.get_instances `tactic_doc >>=
  list.mmap (λ dcl, mk_const dcl >>= eval_expr tactic_doc_entry)

/-- `add_tactic_doc tde` adds a declaration to the environment
with `tde` as its body and tags it with the `tactic_doc`
attribute. If `tde.decl_names` has exactly one entry `` `decl`` and
if `tde.description` is the empty string, `add_tactic_doc` uses the doc
string of `decl` as the description. -/
meta def tactic.add_tactic_doc (tde : tactic_doc_entry) : tactic unit :=
do when (tde.description = "" ∧ tde.inherit_description_from.is_none ∧ tde.decl_names.length ≠ 1) $
     fail "A tactic doc entry must either:
 1. have a description written as a doc-string for the `add_tactic_doc` invocation, or
 2. have a single declaration in the `decl_names` field, to inherit a description from, or
 3. explicitly indicate the declaration to inherit the description from using
    `inherit_description_from`.",
   tde ← if tde.description = "" then tde.update_description else return tde,
   let decl_name := (tde.name ++ tde.category.to_string).mk_hashed_name `tactic_doc,
   add_decl $ mk_definition decl_name [] `(tactic_doc_entry) (reflect tde),
   tactic_doc_entry_attr.set decl_name () tt none

/--
A command used to add documentation for a tactic, command, hole command, or attribute.

Usage: after defining an interactive tactic, command, or attribute,
add its documentation as follows.
```lean
/--
describe what the command does here
-/
add_tactic_doc
{ name := "display name of the tactic",
  category := cat,
  decl_names := [`dcl_1, `dcl_2],
  tags := ["tag_1", "tag_2"]
}
```

The argument to `add_tactic_doc` is a structure of type `tactic_doc_entry`.
* `name` refers to the display name of the tactic; it is used as the header of the doc entry.
* `cat` refers to the category of doc entry.
  Options: `doc_category.tactic`, `doc_category.cmd`, `doc_category.hole_cmd`, `doc_category.attr`
* `decl_names` is a list of the declarations associated with this doc. For instance,
  the entry for `linarith` would set ``decl_names := [`tactic.interactive.linarith]``.
  Some entries may cover multiple declarations.
  It is only necessary to list the interactive versions of tactics.
* `tags` is an optional list of strings used to categorize entries.
* The doc string is the body of the entry. It can be formatted with markdown.
  What you are reading now is the description of `add_tactic_doc`.

If only one related declaration is listed in `decl_names` and if this
invocation of `add_tactic_doc` does not have a doc string, the doc string of
that declaration will become the body of the tactic doc entry. If there are
multiple declarations, you can select the one to be used by passing a name to
the `inherit_description_from` field.

If you prefer a tactic to have a doc string that is different then the doc entry,
you should write the doc entry as a doc string for the `add_tactic_doc` invocation.

Note that providing a badly formed `tactic_doc_entry` to the command can result in strange error
messages.

-/
@[user_command] meta def add_tactic_doc_command (mi : interactive.decl_meta_info)
  (_ : parse $ tk "add_tactic_doc") : parser unit := do
pe ← parser.pexpr,
e ← eval_pexpr tactic_doc_entry pe,
let e : tactic_doc_entry := match mi.doc_string with
  | some desc := { description := desc, ..e }
  | none := e
  end,
tactic.add_tactic_doc e .

/--
At various places in mathlib, we leave implementation notes that are referenced from many other
files. To keep track of these notes, we use the command `library_note`. This makes it easy to
retrieve a list of all notes, e.g. for documentation output.

These notes can be referenced in mathlib with the syntax `Note [note id]`.
Often, these references will be made in code comments (`--`) that won't be displayed in docs.
If such a reference is made in a doc string or module doc, it will be linked to the corresponding
note in the doc display.

Syntax:
```
/--
note message
-/
library_note "note id"
```

An example from `meta.expr`:

```
/--
Some declarations work with open expressions, i.e. an expr that has free variables.
Terms will free variables are not well-typed, and one should not use them in tactics like
`infer_type` or `unify`. You can still do syntactic analysis/manipulation on them.
The reason for working with open types is for performance: instantiating variables requires
iterating through the expression. In one performance test `pi_binders` was more than 6x
quicker than `mk_local_pis` (when applied to the type of all imported declarations 100x).
-/
library_note "open expressions"
```

This note can be referenced near a usage of `pi_binders`:

```
-- See Note [open expressions]
/-- behavior of f -/
def f := pi_binders ...
```
-/
add_tactic_doc
{ name                     := "library_note",
  category                 := doc_category.cmd,
  decl_names               := [`library_note, `tactic.add_library_note],
  tags                     := ["documentation"],
  inherit_description_from := `library_note }

add_tactic_doc
{ name                     := "add_tactic_doc",
  category                 := doc_category.cmd,
  decl_names               := [`add_tactic_doc_command, `tactic.add_tactic_doc],
  tags                     := ["documentation"],
  inherit_description_from := `add_tactic_doc_command }

add_tactic_doc
{ name := "copy_doc_string",
  category := doc_category.cmd,
  decl_names := [`copy_doc_string_cmd, `tactic.copy_doc_string],
  tags := ["documentation"],
  inherit_description_from := `copy_doc_string_cmd }

-- add docs to core tactics

/--
The congruence closure tactic `cc` tries to solve the goal by chaining
equalities from context and applying congruence (i.e. if `a = b`, then `f a = f b`).
It is a finishing tactic, i.e. it is meant to close
the current goal, not to make some inconclusive progress.
A mostly trivial example would be:

```lean
example (a b c : ℕ) (f : ℕ → ℕ) (h: a = b) (h' : b = c) : f a = f c := by cc
```

As an example requiring some thinking to do by hand, consider:

```lean
example (f : ℕ → ℕ) (x : ℕ)
  (H1 : f (f (f x)) = x) (H2 : f (f (f (f (f x)))) = x) :
  f x = x :=
by cc
```

The tactic works by building an equality matching graph. It's a graph where
the vertices are terms and they are linked by edges if they are known to
be equal. Once you've added all the equalities in your context, you take
the transitive closure of the graph and, for each connected component
(i.e. equivalence class) you can elect a term that will represent the
whole class and store proofs that the other elements are equal to it.
You then take the transitive closure of these equalities under the
congruence lemmas.

The `cc` implementation in Lean does a few more tricks: for example it
derives `a=b` from `nat.succ a = nat.succ b`, and `nat.succ a !=
nat.zero` for any `a`.

* The starting reference point is Nelson, Oppen, [Fast decision procedures based on congruence
closure](http://www.cs.colorado.edu/~bec/courses/csci5535-s09/reading/nelson-oppen-congruence.pdf),
Journal of the ACM (1980)

* The congruence lemmas for dependent type theory as used in Lean are described in
[Congruence closure in intensional type theory](https://leanprover.github.io/papers/congr.pdf)
(de Moura, Selsam IJCAR 2016).
-/
add_tactic_doc
{ name := "cc (congruence closure)",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.cc],
  tags := ["core", "finishing"] }

/--
`conv {...}` allows the user to perform targeted rewriting on a goal or hypothesis,
by focusing on particular subexpressions.

See <https://leanprover-community.github.io/extras/conv.html> for more details.

Inside `conv` blocks, mathlib currently additionally provides
* `erw`,
* `ring`, `ring2` and `ring_exp`,
* `norm_num`,
* `norm_cast`,
* `apply_congr`, and
* `conv` (within another `conv`).

`apply_congr` applies congruence lemmas to step further inside expressions,
and sometimes gives between results than the automatically generated
congruence lemmas used by `congr`.

Using `conv` inside a `conv` block allows the user to return to the previous
state of the outer `conv` block after it is finished. Thus you can continue
editing an expression without having to start a new `conv` block and re-scoping
everything. For example:
```lean
example (a b c d : ℕ) (h₁ : b = c) (h₂ : a + c = a + d) : a + b = a + d :=
by conv {
  to_lhs,
  conv {
    congr, skip,
    rw h₁,
  },
  rw h₂,
}
```
Without `conv`, the above example would need to be proved using two successive
`conv` blocks, each beginning with `to_lhs`.

Also, as a shorthand, `conv_lhs` and `conv_rhs` are provided, so that
```lean
example : 0 + 0 = 0 :=
begin
  conv_lhs { simp }
end
```
just means
```lean
example : 0 + 0 = 0 :=
begin
  conv { to_lhs, simp }
end
```
and likewise for `to_rhs`.
-/
add_tactic_doc
{ name := "conv",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.conv],
  tags := ["core"] }

add_tactic_doc
{ name := "simp",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.simp],
  tags := ["core", "simplification"] }

/--
Accepts terms with the type `component tactic_state string` or `html empty` and
renders them interactively.
Requires a compatible version of the vscode extension to view the resulting widget.

### Example:

```lean
/-- A simple counter that can be incremented or decremented with some buttons. -/
meta def counter_widget {π α : Type} : component π α :=
component.ignore_props $ component.mk_simple int int 0 (λ _ x y, (x + y, none)) (λ _ s,
  h "div" [] [
    button "+" (1 : int),
    html.of_string $ to_string $ s,
    button "-" (-1)
  ]
)

#html counter_widget
```
-/
add_tactic_doc
{ name := "#html",
  category := doc_category.cmd,
  decl_names := [`show_widget_cmd],
  tags := ["core", "widgets"] }

/--
The `add_decl_doc` command is used to add a doc string to an existing declaration.

```lean
def foo := 5

/--
Doc string for foo.
-/
add_decl_doc foo
```
-/
@[user_command] meta def add_decl_doc_command (mi : interactive.decl_meta_info)
  (_ : parse $ tk "add_decl_doc") : parser unit := do
n ← parser.ident,
n ← resolve_constant n,
some doc ← pure mi.doc_string | fail "add_decl_doc requires a doc string",
add_doc_string n doc

add_tactic_doc
{ name := "add_decl_doc",
  category := doc_category.cmd,
  decl_names := [``add_decl_doc_command],
  tags := ["documentation"] }


partial def inf (u : Unit) : List Unit := u :: inf u

theorem aa : False :=
  nomatch (⟨inf._unsafe_rec (), rfl⟩ : ∃ l, l = () :: l)