import condensed.extr.basic
import condensed.proetale_site
import condensed.basic
import category_theory.sites.induced_topology

import for_mathlib.sheafification_equiv_compatibility
import for_mathlib.presieve

noncomputable theory

open category_theory

universes u v' u'

lemma ExtrDisc.cover_dense :
  cover_dense proetale_topology.{u} ExtrDisc_to_Profinite.{u} :=
  cover_dense.mk $ λ U,
begin
  change ∃ R, _,
  obtain ⟨⟨T,hT,π,hπ⟩⟩ := enough_projectives.presentation U,
  dsimp at hT hπ,
  let R : presieve U := presieve.of_arrows (λ i : punit, T) (λ i, π),
  use R,
  split,
  { refine ⟨punit, infer_instance, λ i, T, λ i, π, λ x, ⟨punit.star, _⟩, rfl⟩,
    rw Profinite.epi_iff_surjective at hπ,
    exact hπ x },
  intros Y f hf,
  change nonempty _,
  rcases hf with ⟨a,b⟩,
  let t : presieve.cover_by_image_structure ExtrDisc_to_Profinite π := _,
  swap,
  { resetI,
    refine ⟨⟨T⟩, 𝟙 _, π, by simp⟩ },
  use t,
end

def ExtrDisc.proetale_topology : grothendieck_topology ExtrDisc.{u} :=
  ExtrDisc.cover_dense.induced_topology.{u}

instance ExtrDisc_proetale_topology_filtered (X : ExtrDisc.{u}) :
  is_filtered (ExtrDisc.proetale_topology.{u}.cover X)ᵒᵖ := infer_instance

@[derive category]
def ExtrSheaf (C : Type u') [category.{v'} C] := Sheaf ExtrDisc.proetale_topology.{u} C

-- TODO: cover_densed.Sheaf_equiv still has unecessary universe restrictions that can be relaxed.
def Condensed_ExtrSheaf_equiv (C : Type u') [category.{u+1} C] [limits.has_limits C] :
  ExtrSheaf.{u} C ≌ Condensed.{u} C :=
ExtrDisc.cover_dense.Sheaf_equiv_of_cover_preserving_cover_lifting
  ExtrDisc.cover_dense.locally_cover_dense.induced_topology_cover_preserving
  ExtrDisc.cover_dense.locally_cover_dense.induced_topology_cover_lifting

-- Sanity check
@[simp] lemma Condensed_ExtrSheaf_equiv_inverse_val (C : Type u') [category.{u+1} C]
  [limits.has_limits C] (F : Condensed.{u} C) :
  ((Condensed_ExtrSheaf_equiv C).inverse.obj F).val = ExtrDisc_to_Profinite.op ⋙ F.val := rfl

def ExtrDisc_sheafification_iso :
  (whiskering_left _ _ _).obj ExtrDisc_to_Profinite.op ⋙
  presheaf_to_Sheaf ExtrDisc.proetale_topology Ab.{u+1} ≅
  presheaf_to_Sheaf proetale_topology _ ⋙ (Condensed_ExtrSheaf_equiv _).inverse :=
sites.pullback_sheafification_compatibility _ _
ExtrDisc.cover_dense.locally_cover_dense.induced_topology_cover_lifting
_

open opposite

theorem is_ExtrSheaf_of_types_of_is_sheaf_ExtrDisc_proetale_topology
  (F : ExtrDiscᵒᵖ ⥤ Type u') (H : presieve.is_sheaf ExtrDisc.proetale_topology F) :
  is_ExtrSheaf_of_types F :=
begin
  introsI B ι _ X f hf x hx,
  let S : presieve B := presieve.of_arrows X f,
  specialize H (sieve.generate S) _,
  { dsimp [ExtrDisc.proetale_topology],
    let R : presieve B.val := presieve.of_arrows (λ i, (X i).val) (λ i, (f i).val),
    use R,
    split,
    { use [ι, infer_instance, (λ i, (X i).val), (λ i, (f i).val), hf, rfl] },
    { intros Y f hf,
      rcases hf with ⟨i⟩,
      use [X i, f i, 𝟙 _],
      refine ⟨_, by simp⟩,
      use [X i, 𝟙 _, (f i), presieve.of_arrows.mk i],
      simp } },
  rw ← presieve.is_sheaf_for_iff_generate at H,
  let t : S.family_of_elements F := presieve.mk_family_of_elements_of_arrows X f F x,
  have ht : t.compatible := presieve.mk_family_of_elements_of_arrows_compatible X f F x hx,
  specialize H t ht,
  -- now use H.
  obtain ⟨tt,htt,htt'⟩ := H,
  refine ⟨tt,_,_⟩,
  { dsimp,
    intros i,
    specialize htt (f i) (presieve.of_arrows.mk i),
    rw htt,
    apply presieve.mk_family_of_elements_of_arrows_eval _ _ _ _ hx },
  { intros y hy,
    apply htt',
    intros Z f hf,
    rcases hf with ⟨i⟩,
    rw hy,
    symmetry,
    apply presieve.mk_family_of_elements_of_arrows_eval _ _ _ _ hx }
end

theorem is_seprated_of_is_ExtrSheaf_of_types
  (F : ExtrDiscᵒᵖ ⥤ Type u') (H : is_ExtrSheaf_of_types F) :
  presieve.is_separated ExtrDisc.proetale_topology F :=
begin
  intros B S hS x t₁ t₂ h₁ h₂,
  change proetale_topology _ _ at hS,
  rw ExtrDisc.cover_dense.locally_cover_dense.pushforward_cover_iff_cover_pullback at hS,
  obtain ⟨⟨T,hT⟩,rfl⟩ := hS,
  obtain ⟨R,hR,hRT⟩ := hT,
  obtain ⟨ι, _, X, f, surj, rfl⟩ := hR,
  resetI,
  let XX : ι → ExtrDisc := λ i, (X i).pres,
  let ff : Π i, (XX i) ⟶ B := λ i, ⟨(X i).pres_π ≫ f i⟩,
  have surjff : ∀ b : B, ∃ (i : ι) (q : XX i), (ff i) q = b,
  { intros b,
    obtain ⟨i,y,rfl⟩ := surj b,
    obtain ⟨z,rfl⟩ := (X i).pres_π_surjective y,
    use [i,z,rfl] },
  have hff : ∀ i, T (ff i).val,
  { intros i,
    dsimp [ff],
    apply sieve.downward_closed,
    apply hRT,
    exact presieve.of_arrows.mk i },
  let xx : Π i, F.obj (op (XX i)) := λ i, x _ _,
  swap, { exact ff i },
  swap, { exact hff i },
  specialize H B ι XX ff surjff xx _,
  { intros i j Z g₁ g₂ h,
    have hxcompat : x.compatible,
    { apply  presieve.is_compatible_of_exists_amalgamation,
      exact ⟨t₁, h₁⟩ },
    dsimp [presieve.family_of_elements.compatible] at hxcompat,
    dsimp [xx],
    specialize hxcompat g₁ g₂,
    apply hxcompat,
    exact h },
  obtain ⟨t,ht,ht'⟩ := H,
  have ht₁ : t₁ = t,
  { apply ht',
    intros i,
    apply h₁ },
  have ht₂ : t₂ = t,
  { apply ht',
    intros i,
    apply h₂ },
  rw [ht₁, ht₂]
end

theorem is_sheaf_ExtrDisc_proetale_topology_of_is_ExtrSheaf_of_types
  (F : ExtrDiscᵒᵖ ⥤ Type u') (H : is_ExtrSheaf_of_types F) :
  presieve.is_sheaf ExtrDisc.proetale_topology F :=
begin
  have hF : presieve.is_separated ExtrDisc.proetale_topology F,
  { apply is_seprated_of_is_ExtrSheaf_of_types,
    assumption },
  intros B S hS,
  rw ← presieve.is_separated_for_and_exists_is_amalgamation_iff_sheaf_for,
  split, { apply hF _ hS },
  intros x hx,
  change proetale_topology _ _ at hS,
  rw ExtrDisc.cover_dense.locally_cover_dense.pushforward_cover_iff_cover_pullback at hS,
  obtain ⟨⟨T,hT⟩,rfl⟩ := hS,
  obtain ⟨R,hR,hRT⟩ := hT,
  obtain ⟨ι, _, X, f, surj, rfl⟩ := hR,
  resetI,
  let XX : ι → ExtrDisc := λ i, (X i).pres,
  let ff : Π i, (XX i) ⟶ B := λ i, ⟨(X i).pres_π ≫ f i⟩,
  have surjff : ∀ b : B, ∃ (i : ι) (q : XX i), (ff i) q = b,
  { intros b,
    obtain ⟨i,y,rfl⟩ := surj b,
    obtain ⟨z,rfl⟩ := (X i).pres_π_surjective y,
    use [i,z,rfl] },
  have hff : ∀ i, T (ff i).val,
  { intros i,
    dsimp [ff],
    apply sieve.downward_closed,
    apply hRT,
    exact presieve.of_arrows.mk i },
  let xx : Π i, F.obj (op (XX i)) := λ i, x _ _,
  swap, { exact ff i },
  swap, { exact hff i },
  specialize H B ι XX ff surjff xx _,
  { intros i j Z g₁ g₂ h,
    dsimp [presieve.family_of_elements.compatible] at hx,
    dsimp [xx],
    specialize hx g₁ g₂,
    apply hx,
    exact h },
  obtain ⟨t,ht,ht'⟩ := H,
  use t,
  intros Y f hf,
  let PP : ι → Profinite := λ i, Profinite.pullback f.val (ff i).val,
  let QQ : ι → ExtrDisc := λ i, (PP i).pres,
  let ππ : Π i, (QQ i) ⟶ XX i := λ i, ⟨(PP i).pres_π ≫ Profinite.pullback.snd _ _⟩,
  let gg : Π i, (QQ i) ⟶ Y := λ i,
    ⟨(PP i).pres_π ≫ Profinite.pullback.fst _ _⟩,
  let W : sieve Y := sieve.generate (presieve.of_arrows QQ gg),
  specialize hF W _,
  { change ∃ _, _,
    use presieve.of_arrows (λ i, (QQ i).val) (λ i, (gg i).val),
    split,
    { use [ι, infer_instance, (λ i, (QQ i).val), (λ i, (gg i).val)],
      refine ⟨_,rfl⟩,
      intros y,
      obtain ⟨i,t,ht⟩ := surj (f y),
      obtain ⟨w,hw⟩ := (X i).pres_π_surjective t,
      obtain ⟨z,hz⟩ := (PP i).pres_π_surjective ⟨⟨y,w⟩,_⟩,
      swap, { dsimp, rw hw, exact ht.symm },
      use [i, z],
      dsimp [gg],
      rw hz, refl },
    { intros Z f hf,
      obtain ⟨i⟩ := hf,
      change ∃ _, _,
      use [(QQ i), gg i, 𝟙 _],
      split,
      { apply sieve.le_generate,
        apply presieve.of_arrows.mk },
      { ext1, simp } } },
  dsimp [presieve.is_separated_for] at hF,
  have : ∀ (Z : ExtrDisc) (g : Z ⟶ Y) (hg : W g),
    ∃ (i : ι) (e : Z ⟶ QQ i), g = e ≫ gg i,
  { intros Z g hg,
    obtain ⟨QQ',e₁,e₂,h1,h2⟩ := hg,
    obtain ⟨i⟩ := h1,
    use [i, e₁, h2.symm] },
  choose ii ee hee using this,
  let y : presieve.family_of_elements F W := λ Z g hg,
    F.map (ee _ _ hg ≫ ππ _).op (xx (ii _ _ hg)),
  have hy : y.compatible,
  { intros T₁ T₂ Z g₁ g₂ f₁ f₂ h₁ h₂ w,
    dsimp [y, xx],
    simp only [← F.map_comp, ← op_comp],
    change (F.map _ ≫ F.map _) _ = (F.map _ ≫ F.map _) _,
    simp only [← F.map_comp, ← op_comp],
    apply hx,
    apply_fun (λ e, e ≫ f) at w,
    simp only [category.assoc] at w ⊢,
    convert w using 2,
    { ext1,
      dsimp [ππ, ff],
      simp only [category.assoc],
      rw [← Profinite.pullback.condition, ← category.assoc],
      change ((ee T₁ f₁ h₁ ≫ gg _) ≫ f).val = (f₁ ≫ f).val,
      congr' 2,
      symmetry,
      apply hee },
    { ext1,
      dsimp [ππ, ff],
      simp only [category.assoc],
      rw [← Profinite.pullback.condition, ← category.assoc],
      change ((ee T₂ f₂ h₂ ≫ gg _) ≫ f).val = (f₂ ≫ f).val,
      congr' 2,
      symmetry,
      apply hee } },
  apply hF y (F.map f.op t) (x f hf),
  { intros L e he,
    dsimp [y],
    have := hee _ _ he,
    conv_lhs { rw this },
    rw ← ht,
    simp only [← comp_apply, ← F.map_comp, ← op_comp],
    change (F.map _ ≫ F.map _) _ = (F.map _ ≫ F.map _) _,
    simp_rw [← F.map_comp, ← op_comp],
    congr' 2,
    simp only [category.assoc],
    congr' 1,
    ext1,
    dsimp,
    simp [Profinite.pullback.condition] },
  { intros L e he,
    dsimp [y],
    have := hee _ _ he,
    conv_lhs { rw this },
    dsimp only [xx],
    simp only [← F.map_comp, ← op_comp],
    apply hx,
    simp only [category.assoc],
    congr' 1,
    ext1,
    dsimp,
    simp [Profinite.pullback.condition] }
end

theorem is_ExtrSheaf_of_types_iff (F : ExtrDiscᵒᵖ ⥤ Type u') :
  is_ExtrSheaf_of_types F ↔ presieve.is_sheaf ExtrDisc.proetale_topology F :=
⟨λ H, is_sheaf_ExtrDisc_proetale_topology_of_is_ExtrSheaf_of_types _ H,
  λ H, is_ExtrSheaf_of_types_of_is_sheaf_ExtrDisc_proetale_topology _ H⟩

theorem is_ExtrSheaf_iff (C : Type u') [category.{v'} C]
  (F : ExtrDiscᵒᵖ ⥤ C) :
  is_ExtrSheaf F ↔ presheaf.is_sheaf ExtrDisc.proetale_topology F :=
begin
  rw is_ExtrSheaf_iff_forall_yoneda,
  apply forall_congr (λ T, _),
  apply is_ExtrSheaf_of_types_iff,
end

theorem is_sheaf_ExtrDisc_proetale_iff_product_condition
  (C : Type u') [category.{v'} C] [limits.has_finite_products C]
  (F : ExtrDiscᵒᵖ ⥤ C) :
  presheaf.is_sheaf ExtrDisc.proetale_topology F ↔ ExtrDisc.finite_product_condition F :=
begin
  rw ← is_ExtrSheaf_iff,
  rw is_ExtrSheaf_iff_product_condition,
end

structure ExtrSheafProd (C : Type.{u'}) [category.{v'} C] [limits.has_finite_products C] :=
(val : ExtrDisc.{u}ᵒᵖ ⥤ C)
(cond : ExtrDisc.finite_product_condition val)

namespace ExtrSheafProd

variables (C : Type.{u'}) [category.{v'} C] [limits.has_finite_products C]

@[ext]
structure hom (X Y : ExtrSheafProd C) :=
mk :: (val : X.val ⟶ Y.val)

@[simps]
instance : category (ExtrSheafProd C) :=
{ hom := hom C,
  id := λ X, ⟨𝟙 _⟩,
  comp := λ X Y Z f g, ⟨f.val ≫ g.val⟩ }

end ExtrSheafProd

-- TODO: Break up this structure into individual components... it's too slow as is.
def ExtrSheaf_ExtrSheafProd_equiv (C : Type.{u'}) [category.{v'} C] [limits.has_finite_products C] :
  ExtrSheaf C ≌ ExtrSheafProd C :=
{ functor :=
  { obj := λ F, ⟨F.val,
      (is_sheaf_ExtrDisc_proetale_iff_product_condition _ _).mp F.2⟩,
    map := λ F G f, ⟨f.val⟩,
    map_id' := λ X, by { ext1, refl },
    map_comp' := λ X Y Z f g, by { ext1, refl } },
  inverse :=
  { obj := λ F, ⟨F.val,
      (is_sheaf_ExtrDisc_proetale_iff_product_condition _ _).mpr F.2⟩,
    map := λ F G f, ⟨f.val⟩,
    map_id' := λ X, by { ext1, refl },
    map_comp' := λ X Y Z f g, by { ext1, refl } },
  unit_iso := nat_iso.of_components
    (λ X,
    { hom := ⟨𝟙 _⟩,
      inv := ⟨𝟙 _⟩,
      hom_inv_id' := by { ext1, dsimp, simp },
      inv_hom_id' := by { ext1, dsimp, simp } })
    begin
      intros X Y f,
      ext1,
      dsimp,
      simp,
    end,
  counit_iso := nat_iso.of_components
    (λ X,
    { hom := ⟨𝟙 _⟩,
      inv := ⟨𝟙 _⟩,
      hom_inv_id' := by { ext1, dsimp, simp },
      inv_hom_id' := by { ext1, dsimp, simp } })
    begin
      intros X Y f,
      ext1,
      dsimp,
      simp,
    end,
  functor_unit_iso_comp' := begin
    intros,
    ext1,
    dsimp,
    simp,
  end } .

def Condensed_ExtrSheafProd_equiv (C : Type.{u'}) [category.{u+1} C] [limits.has_limits C] :
  Condensed.{u} C ≌ ExtrSheafProd.{u} C :=
(Condensed_ExtrSheaf_equiv C).symm.trans (ExtrSheaf_ExtrSheafProd_equiv C)

-- Sanity check
@[simp]
lemma Condensed_ExtrSheafProd_equiv_functor_obj_val
  {C : Type.{u'}} [category.{u+1} C] [limits.has_limits C] (F : Condensed C) :
  ((Condensed_ExtrSheafProd_equiv C).functor.obj F).val = ExtrDisc_to_Profinite.op ⋙ F.val := rfl

def ExtrSheafProd_to_presheaf (C : Type.{u'}) [category.{v'} C]
  [limits.has_finite_products C] :
  ExtrSheafProd.{u} C ⥤ ExtrDisc.{u}ᵒᵖ ⥤ C :=
{ obj := λ F, F.val,
  map := λ F G f, f.val,
  map_id' := λ X, rfl,
  map_comp' := λ X Y Z f g, rfl }

instance (C : Type.{u'}) [category.{v'} C]
  [limits.has_finite_products C] : full (ExtrSheafProd_to_presheaf C) :=
{ preimage := λ X Y f, ⟨f⟩,
  witness' := λ _ _ _, rfl }

instance (C : Type.{u'}) [category.{v'} C]
  [limits.has_finite_products C] : faithful (ExtrSheafProd_to_presheaf C) := {}

open category_theory.limits
--set_option pp.universes true

section

open_locale classical

namespace finite_product_colimit_setup
section

parameters {C : Type u'} [category.{u+1} C] [has_limits C] [has_colimits C]
  [has_zero_morphisms C] [has_finite_biproducts C]

parameters {J : Type (u+1)} [small_category J] (K : J ⥤ ExtrSheafProd.{u} C)

parameters {ι : Type} [fintype ι] (X : ι → ExtrDisc.{u})

def KC : ExtrDisc.{u}ᵒᵖ ⥤ C := colimit (K ⋙ ExtrSheafProd_to_presheaf C)

def P₀ : C := ∏ (λ i,  KC.obj (op (X i)))
def P : C := ∏ (λ i : ulift.{u+1} ι,  KC.obj (op (X i.down)))
def S : C := ⨁ (λ i : ι, KC.obj (op (X i)))

def prod_iso_P : P₀ ≅ P :=
{ hom := pi.lift $ λ i, pi.π _ _,
  inv := pi.lift $ λ i, pi.π _ ⟨i⟩ ≫ (iso.refl _).hom,
  hom_inv_id' := by { ext ⟨j⟩, simp },
  inv_hom_id' := by { ext ⟨⟨j⟩⟩, simp }, }

def biprod_iso_P : P ≅ S :=
{ hom := biproduct.lift $ λ b, pi.π (λ i : ulift.{u+1} ι,  KC.obj (op (X i.down))) ⟨b⟩,
  inv := pi.lift $ λ b, biproduct.π _ _,
  hom_inv_id' := by { ext ⟨⟨j⟩⟩, simp },
  inv_hom_id' := begin
    apply biproduct.hom_ext, -- we need to choose the correct extensionality lemma here...
    intros i,
    simp,
  end }

def Q₀ (j : J) : C := ∏ (λ i : ι, (K.obj j).val.obj (op (X i)))
def Q₁ (j : J) : C := ∏ (λ i : ulift.{u} ι, (K.obj j).val.obj (op (X i.down)))
def Q (j : J) : C := ∏ (λ i : ulift.{u+1} ι, (K.obj j).val.obj (op (X i.down)))
def T (j : J) : C := ⨁ (λ i : ι, (K.obj j).val.obj (op (X i)))

def prod_iso_Q (j : J) : Q₀ j ≅ Q j :=
{ hom := pi.lift $ λ b, pi.π _ _,
  inv := pi.lift $ λ b, pi.π _ ⟨b⟩ ≫ (iso.refl _).hom,
  hom_inv_id' := by { ext ⟨j⟩, simp },
  inv_hom_id' := by { ext ⟨⟨j⟩⟩, simp }, }

def prod_iso_Q' (j : J) : Q₀ j ≅ Q₁ j :=
{ hom := pi.lift $ λ b, pi.π _ _,
  inv := pi.lift $ λ b, pi.π (λ (i : ulift ι), (K.obj j).val.obj (op (X i.down))) ⟨b⟩,
  hom_inv_id' := by { ext ⟨j⟩, simp },
  inv_hom_id' := by { ext ⟨⟨j⟩⟩, simp }, }

def biprod_iso_Q (j : J) : Q j ≅ T j :=
{ hom := biproduct.lift $ λ b, pi.π (λ i : ulift.{u+1} ι, (K.obj j).val.obj (op (X i.down))) ⟨b⟩,
  inv := pi.lift $ λ b, biproduct.π _ _,
  hom_inv_id' := by { ext ⟨⟨j⟩⟩, simp },
  inv_hom_id' := begin
    apply biproduct.hom_ext, -- we need to choose the correct extensionality lemma here...
    intros i,
    simp,
  end }

def KQ₀ (j) : (K.obj j).val.obj (op (ExtrDisc.sigma (X ∘ ulift.down))) ≅ Q₀ j :=
begin
  -- Lean is being annoying... again...
  let t : (K.obj j).val.obj (op (ExtrDisc.sigma (X ∘ ulift.down))) ⟶ Q₀ K X j :=
    pi.lift (λ (i : ι), (K.obj j).val.map (ExtrDisc.sigma.ι (X ∘ ulift.down) ⟨i⟩).op),
  have := (K.obj j).cond (ulift ι) (X ∘ ulift.down), dsimp at this,
  let s := _, change is_iso s at this,
  have ht : t = s ≫ (prod_iso_Q' _ _ _).inv,
  { dsimp [s, t, prod_iso_Q'], apply limit.hom_ext, rintros ⟨q⟩,
    simp },
  haveI : is_iso t := by { rw ht, resetI, apply is_iso.comp_is_iso },
  exact as_iso t,
end

def map_Q₀ {i j : J} (f : i ⟶ j) : Q₀ i ⟶ Q₀ j :=
  pi.lift $ λ a, pi.π _ a ≫ (K.map f).val.app _

def map_Q {i j : J} (f : i ⟶ j) : Q i ⟶ Q j :=
  pi.lift $ λ a, pi.π _ a ≫ (K.map f).val.app _

def map_T {i j : J} (f : i ⟶ j) : T i ⟶ T j :=
  biproduct.map $ λ a, (K.map f).val.app _
--λ a, biproduct.π _ a ≫ (K.map f).val.app _

def Q₀_functor : J ⥤ C :=
{ obj := Q₀,
  map := λ i j f, map_Q₀ f,
  map_id' := begin
    intros i,
    dsimp [map_Q₀],
    ext1 ⟨j⟩,
    simp,
  end,
  map_comp' := begin
    intros i j k f g,
    dsimp [map_Q₀],
    ext1,
    simp,
  end }

def Q_functor : J ⥤ C :=
{ obj := Q,
  map := λ i j f, map_Q f,
  map_id' := begin
    intros i, dsimp [map_Q], ext1 ⟨j⟩, simp,
  end,
  map_comp' := begin
    intros i j k f g, dsimp [map_Q], ext1, simp
  end }

def T_functor : J ⥤ C :=
{ obj := T,
  map := λ i j f, map_T f,
  map_id' := by { intros i, dsimp [map_T],
    apply biproduct.hom_ext, intros a, simp, erw category.id_comp },
  map_comp' := begin
    intros i j k f g,
    dsimp [map_T],
    apply biproduct.hom_ext,
    intros a,
    simp
  end }

def KQ₀_nat_iso :
  K ⋙ ExtrSheafProd_to_presheaf _ ⋙ (evaluation _ _).obj (op (ExtrDisc.sigma (X ∘ ulift.down))) ≅
  Q₀_functor :=
nat_iso.of_components (λ j, KQ₀ _)
begin
  intros i j f,
  dsimp [ExtrSheafProd_to_presheaf, Q₀_functor, KQ₀, map_Q₀],
  ext,
  simp,
end

def Q₀Q_nat_iso : Q₀_functor ≅ Q_functor :=
nat_iso.of_components (λ j, prod_iso_Q _)
begin
  intros i j f,
  dsimp [Q₀_functor, prod_iso_Q, map_Q₀, Q_functor, map_Q],
  ext1,
  simp,
end

def QT_nat_iso : Q_functor ≅ T_functor :=
nat_iso.of_components (λ j, biprod_iso_Q _)
begin
  intros i j f,
  dsimp [Q_functor, biprod_iso_Q, map_T, T_functor, map_Q],
  apply biproduct.hom_ext, intros i,
  simp,
end

def colimit_KQ₀_nat_iso :
  KC ≅ ((K ⋙ ExtrSheafProd_to_presheaf _).flip ⋙ colim) :=
colimit_iso_flip_comp_colim (K ⋙ ExtrSheafProd_to_presheaf C)

def colimit_KQ₀_nat_iso_eval : KC.obj (op (ExtrDisc.sigma (X ∘ ulift.down))) ≅
  colimit (K ⋙ ExtrSheafProd_to_presheaf _ ⋙ (evaluation _ _).obj
  (op (ExtrDisc.sigma (X ∘ ulift.down)))) :=
colimit_KQ₀_nat_iso.app _

def CT : C := ⨁ (λ i : ι,
    colimit (K ⋙ ExtrSheafProd_to_presheaf _ ⋙ (evaluation _ _).obj (op (X i))))

def ct_iso (i : ι) :
  (colimit (K ⋙ ExtrSheafProd_to_presheaf _)).obj (op (X i)) ≅
  colimit (K ⋙ ExtrSheafProd_to_presheaf _ ⋙ (evaluation _ _).obj (op (X i))) :=
colimit_KQ₀_nat_iso.app _

def CT_iso : CT ≅ S :=
{ hom := biproduct.map $ λ b, (ct_iso _).inv,
  inv := biproduct.map $ λ b, (ct_iso _).hom,
  hom_inv_id' := begin
    ext1,
    simp,
    erw category.comp_id,
  end,
  inv_hom_id' := begin
    ext1,
    simp,
    erw category.comp_id,
  end }

-- This is the main point where we prove that colimits commute with biproducts.
-- The rest is glue.
def colimit_T_iso : colimit T_functor ≅ CT :=
{ hom := colimit.desc T_functor ⟨CT,
  { app := λ j, biproduct.map $ λ i,
      colimit.ι (K ⋙ ExtrSheafProd_to_presheaf C ⋙
      (evaluation ExtrDiscᵒᵖ C).obj (op (X i))) j,
    naturality' := begin
      intros a b f,
      dsimp [T_functor, map_T],
      apply biproduct.hom_ext',
      intros i,
      simp,
      rw ← colimit.w _ f,
      simp only [category.assoc],
      refl,
    end }⟩,
  inv := biproduct.desc $ λ b,
    colimit.desc (K ⋙ ExtrSheafProd_to_presheaf _ ⋙
    (evaluation _ _).obj (op (X b))) ⟨colimit T_functor,
  { app := λ j, begin
      dsimp [ExtrSheafProd_to_presheaf, T_functor, T],
      apply biproduct.ι _ b,
    end ≫ colimit.ι _ j,
    naturality' := begin
      intros i j f,
      dsimp [ExtrSheafProd_to_presheaf],
      simp,
      rw ← colimit.w _ f,
      dsimp only [T_functor, map_T],
      simp,
    end }⟩,
  hom_inv_id' := begin
    ext1 j,
    dsimp,
    apply biproduct.hom_ext',
    intros b,
    simp,
  end,
  inv_hom_id' := begin
    apply biproduct.hom_ext',
    intros b,
    simp,
    apply colimit.hom_ext,
    intros j,
    simp,
    erw category.comp_id,
  end }

-- We want this to be an isomorphism.
def t : KC.obj (op (ExtrDisc.sigma (X ∘ ulift.down))) ⟶ P₀ :=
  pi.lift $ λ i, KC.map (ExtrDisc.sigma.ι (X ∘ ulift.down) ⟨i⟩).op

lemma key_lemma : t =
  colimit_KQ₀_nat_iso_eval.hom ≫
  (has_colimit.iso_of_nat_iso KQ₀_nat_iso).hom ≫
  (has_colimit.iso_of_nat_iso Q₀Q_nat_iso).hom ≫
  (has_colimit.iso_of_nat_iso QT_nat_iso).hom ≫
  colimit_T_iso.hom ≫ CT_iso.hom ≫
  biprod_iso_P.inv ≫ prod_iso_P.inv :=
begin
  dsimp [prod_iso_P, biprod_iso_P, CT_iso, colimit_T_iso, colimit_KQ₀_nat_iso_eval, t,
    colimit_KQ₀_nat_iso, KC, ct_iso],
  ext : 2,
  simp,
  erw colimit.ι_desc_assoc,
  dsimp [cocones.precompose, KQ₀_nat_iso, Q₀Q_nat_iso, QT_nat_iso, KQ₀,
    prod_iso_Q, biprod_iso_Q],
  simp,
  erw colimit.ι_desc,
  dsimp,
  simp,
end

theorem main : is_iso t :=
begin
  rw key_lemma,
  apply is_iso.comp_is_iso, -- ;-)
end

end
end finite_product_colimit_setup

variables {C : Type u'} [category.{u+1} C]
  [has_zero_morphisms C] [has_finite_biproducts C]

-- move me
lemma pi_π_comp_eq_to_hom {α : Type} [fintype α] (X : α → C) (a b : α) (h : a = b) :
  pi.π X a ≫ eq_to_hom (by rw h) = pi.π X b :=
by { induction h, simp }

-- move me
lemma pi_π_comp_eq_to_hom' {α : Type u} [fintype α] (X : α → C) (a b : α) (h : a = b) :
  pi.π X a ≫ eq_to_hom (by rw h) = pi.π X b :=
by { induction h, simp }

-- move me
attribute [reassoc] ExtrDisc.sigma.ι_desc

variables [has_limits C] [has_colimits C]

lemma ExtrDisc.sigma.eq_to_hom_ι_eq_ι
  {α : Type u} [fintype α] (X : α → ExtrDisc.{u})
  (a b : α) (h : a = b) :
  eq_to_hom (by rw h) ≫ ExtrDisc.sigma.ι X a = ExtrDisc.sigma.ι X b :=
begin
  induction h, simp,
end

def ExtrDisc.sigma_iso_of_equiv {α β : Type u} [fintype α] [fintype β] (X : α → ExtrDisc.{u})
  (e : β ≃ α) :
  ExtrDisc.sigma (X ∘ e) ≅ ExtrDisc.sigma X :=
{ hom := ExtrDisc.sigma.desc _ $ λ b, ExtrDisc.sigma.ι _ _,
  inv := ExtrDisc.sigma.desc _ $ λ a, eq_to_hom begin
    dsimp,
    refine congr_arg _ _,
    exact (e.apply_symm_apply _).symm,
  end ≫ ExtrDisc.sigma.ι _ (e.symm a),
  hom_inv_id' := begin
    apply ExtrDisc.sigma.hom_ext, intros b,
    simp [ExtrDisc.sigma.ι_desc_assoc, ExtrDisc.sigma.ι_desc],
    apply ExtrDisc.sigma.eq_to_hom_ι_eq_ι (X ∘ e),
    simp,
  end,
  inv_hom_id' := begin
    apply ExtrDisc.sigma.hom_ext, intros b,
    simp [ExtrDisc.sigma.ι_desc_assoc, ExtrDisc.sigma.ι_desc],
    apply ExtrDisc.sigma.eq_to_hom_ι_eq_ι X,
    simp,
  end }

lemma finite_product_condition_holds_for_colimit
  {J : Type (u+1)} [small_category J] (K : J ⥤ ExtrSheafProd.{u} C) [has_colimits C] :
  ExtrDisc.finite_product_condition (colimit (K ⋙ ExtrSheafProd_to_presheaf C)) :=
begin
  introsI ι _ X,
  let e : ι ≃ fin _ := fintype.equiv_fin _,
  let X' := X ∘ e.symm,
  dsimp,
  let E : ExtrDisc.sigma (X' ∘ ulift.down) ≅ ExtrDisc.sigma X :=
    ExtrDisc.sigma_iso_of_equiv X (equiv.ulift.trans e.symm),
  have := finite_product_colimit_setup.main K X',
  let eL : (colimit (K ⋙ ExtrSheafProd_to_presheaf C)).obj (op (ExtrDisc.sigma X)) ≅
    (colimit (K ⋙ ExtrSheafProd_to_presheaf C)).obj (op (ExtrDisc.sigma (X' ∘ ulift.down))) :=
    functor.map_iso _ E.op,
  let E' : finite_product_colimit_setup.P₀ K X' ≅
    ∏ λ (i : ι), (colimit (K ⋙ ExtrSheafProd_to_presheaf C)).obj (op (X i)) :=
    ⟨limits.pi.lift _, limits.pi.lift _,_,_⟩,
  rotate,
  { intros i,
    dsimp [finite_product_colimit_setup.P₀],
    refine pi.π _ (e i) ≫ _,
    refine category_theory.functor.map _ _,
    refine quiver.hom.op _,
    refine eq_to_hom _,
    refine congr_arg X _,
    exact (e.symm_apply_apply _).symm },
  { intros i,
    refine pi.π _ (e.symm i) },
  { apply limits.limit.hom_ext,
    rintro ⟨j⟩, dsimp,
    simp only [eq_to_hom_op, category.assoc, limit.lift_π, fan.mk_π_app, category.id_comp],
    rw category_theory.eq_to_hom_map,
    apply pi_π_comp_eq_to_hom, simp },
  { apply limits.limit.hom_ext,
    rintro ⟨j⟩, dsimp,
    simp only [eq_to_hom_op, category.assoc, limit.lift_π, fan.mk_π_app,
      category.id_comp],
    rw category_theory.eq_to_hom_map,
    rw limit.lift_π_assoc, dsimp,
    change _ = pi.π _ _,
    apply pi_π_comp_eq_to_hom'
      (λ (i : ι), (colimit (K ⋙ ExtrSheafProd_to_presheaf C)).obj (op (X i))), simp },
  let t := _, change is_iso t, let s := _, change is_iso s at this,
  have ht : t = eL.hom ≫ s ≫ E'.hom,
  { dsimp [t, eL, s, E', E],
    apply limit.hom_ext, rintros ⟨j⟩,
    simp only [category.assoc, limit.lift_π],
    dsimp,
    rw category_theory.eq_to_hom_op,
    rw category_theory.eq_to_hom_map,
    dsimp [finite_product_colimit_setup.t],
    simp only [limit.lift_π_assoc],
    dsimp [finite_product_colimit_setup.KC],
    simp only [← category.assoc, ← functor.map_comp, ← op_comp],
    erw ExtrDisc.sigma.ι_desc,
    dsimp,
    rw ← ExtrDisc.sigma.eq_to_hom_ι_eq_ι X (e.symm (e j)) j (by simp),
    simp [category_theory.eq_to_hom_map] },
  rw ht, resetI, apply_instance,
end

instance ExtrSheafProd_to_presheaf_creates_colimit
  {J : Type (u+1)} [small_category J] (K : J ⥤ ExtrSheafProd.{u} C) [has_colimits C] :
  creates_colimit K (ExtrSheafProd_to_presheaf.{u} C) :=
creates_colimit_of_fully_faithful_of_iso
⟨colimit (K ⋙ ExtrSheafProd_to_presheaf _), finite_product_condition_holds_for_colimit _⟩ $
eq_to_iso rfl

instance ExtrSheafProd_to_presheaf_creates_colimits_of_shape
  {J : Type (u+1)} [small_category J] [has_colimits C] :
  creates_colimits_of_shape J (ExtrSheafProd_to_presheaf.{u} C) :=
⟨λ K,
{ reflects := begin
    intros c hc,
    haveI : has_colimit (K ⋙ ExtrSheafProd_to_presheaf C) := has_colimit.mk ⟨_,hc⟩,
    apply is_colimit_of_reflects (ExtrSheafProd_to_presheaf.{u} C),
    assumption,
  end,
  lifts := λ c hc,
  { lifted_cocone := begin
      haveI : has_colimit (K ⋙ ExtrSheafProd_to_presheaf C) := has_colimit.mk ⟨_,hc⟩,
      exact lift_colimit hc,
    end,
    valid_lift := begin
      haveI : has_colimit (K ⋙ ExtrSheafProd_to_presheaf C) := has_colimit.mk ⟨_,hc⟩,
      apply lifted_colimit_maps_to_original,
    end } }⟩

instance ExtrSheafProd_to_presheaf_creates_colimits [has_colimits C] :
  creates_colimits (ExtrSheafProd_to_presheaf.{u} C) := by constructor

-- Forgetting to presheaves, and restricting to `ExtrDisc` creates colimits.
instance Condensed_to_ExtrDisc_presheaf_creates_colimits [has_colimits C] :
  creates_colimits
  ((Sheaf_to_presheaf _ _ : Condensed C ⥤ _) ⋙
  (whiskering_left _ _ _).obj (ExtrDisc_to_Profinite.op)) :=
begin
  change creates_colimits
    ((Condensed_ExtrSheafProd_equiv C).functor ⋙ ExtrSheafProd_to_presheaf C),
  apply_with category_theory.comp_creates_colimits { instances := ff}; apply_instance
end

end


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

-- import algebraic_geometry.sheafed_space
-- import algebraic_geometry.presheafed_space.has_colimits
-- import algebraic_geometry.sheaf_pullback
-- /-!
-- # `PresheafedSpace C` has colimits.

-- If `C` has limits, then the category `PresheafedSpace C` has colimits,
-- and the forgetful functor to `Top` preserves these colimits.

-- When restricted to a diagram where the underlying continuous maps are open embeddings,
-- this says that we can glue presheaved spaces.

-- Given a diagram `F : J ⥤ PresheafedSpace C`,
-- we first build the colimit of the underlying topological spaces,
-- as `colimit (F ⋙ PresheafedSpace.forget C)`. Call that colimit space `X`.

-- Our strategy is to push each of the presheaves `F.obj j`
-- forward along the continuous map `colimit.ι (F ⋙ PresheafedSpace.forget C) j` to `X`.
-- Since pushforward is functorial, we obtain a diagram `J ⥤ (presheaf C X)ᵒᵖ`
-- of presheaves on a single space `X`.
-- (Note that the arrows now point the other direction,
-- because this is the way `PresheafedSpace C` is set up.)

-- The limit of this diagram then constitutes the colimit presheaf.
-- -/

-- noncomputable theory

-- universes v' u' v u

-- open category_theory
-- open Top
-- open Top.presheaf
-- open topological_space
-- open opposite
-- open category_theory.category
-- open category_theory.limits
-- open category_theory.functor

-- variables {J : Type u'} [category.{v'} J]
-- variables (C : Type u) [category.{v} C] [concrete_category.{v} C] [has_colimits C] [has_limits C]
-- variables [preserves_limits (category_theory.forget C)]
-- variables [preserves_filtered_colimits (category_theory.forget C)]
-- variables [reflects_isomorphisms (category_theory.forget C)]

-- namespace algebraic_geometry

-- namespace SheafedSpace

-- -- @[simps]
-- -- def componentwise_diagram (F : J ⥤ SheafedSpace.{v} C)
-- --   [has_limit F] (U : opens (limits.limit F).carrier) : Jᵒᵖ ⥤ C :=
-- -- { obj := λ j, (F.obj (unop j)).presheaf.obj (op ((opens.map (colimit.ι F (unop j)).base).obj U)),
-- --   map := λ j k f, (F.map f.unop).c.app _ ≫ (F.obj (unop k)).presheaf.map
-- --     (eq_to_hom (by { rw [← colimit.w F f.unop, comp_base], refl })),
-- --   map_comp' := λ i j k f g,
-- --   begin
-- --     cases U,
-- --     dsimp,
-- --     simp_rw [map_comp_c_app, category.assoc],
-- --     congr' 1,
-- --     rw [Top.presheaf.pushforward.comp_inv_app, Top.presheaf.pushforward_eq_hom_app,
-- --       category_theory.nat_trans.naturality_assoc, Top.presheaf.pushforward_map_app],
-- --     congr' 1,
-- --     rw [category.id_comp, ← (F.obj (unop k)).presheaf.map_comp],
-- --     erw ← (F.obj (unop k)).presheaf.map_comp,
-- --     congr
-- --   end }

-- variable [has_limits_of_shape J Top.{v}]

-- noncomputable!
-- def pushforward_diagram_to_limit.map (F : J ⥤ SheafedSpace.{v} C) {j j' : J} (f : j ⟶ j') :
--   (sheaf.pullback C (limit.π (F ⋙ forget C) j')).obj (F.obj j').sheaf ⟶
--     (sheaf.pullback C (limit.π (F ⋙ forget C) j)).obj (F.obj j).sheaf :=
-- begin
--   refine ((Top.sheaf.pullback_comp _ _ _ ≪≫ Top.sheaf.pullback_congr C
--     (limit.w (F ⋙ SheafedSpace.forget C) f)).app ((F.obj j').sheaf)).inv ≫
--     (Top.sheaf.pullback C (limit.π (F ⋙ forget C) j)).map _,
--   refine ((Top.sheaf.pullback_pushforward_adjunction _ _).hom_equiv _ _).symm _,
--   exact ⟨(F.map f).c⟩
-- end

-- -- @[simps] noncomputable!
-- def pushforward_diagram_to_colimit (F : J ⥤ SheafedSpace.{v} C) :
--   J ⥤ (Top.sheaf C (limit (F ⋙ SheafedSpace.forget C)))ᵒᵖ :=
-- { obj := λ j, op ((Top.sheaf.pullback C (limit.π (F ⋙ SheafedSpace.forget C) j)).obj (F.obj j).sheaf),
--   map := λ j j' f, (pushforward_diagram_to_limit.map C F f).op,
--   map_id' := λ j,
--   begin
--     apply quiver.hom.unop_inj,
--     rw [quiver.hom.unop_op, unop_id],
--     dsimp only [pushforward_diagram_to_limit.map],
--     simp only [category.assoc, adjunction.hom_equiv_counit, functor.map_comp, ← functor.comp_map,
--       nat_iso.app_inv, functor.map_id],
--     rw ← nat_trans.naturality_assoc,
--     -- simp { single_pass := tt },
--     -- simp { single_pass := tt },
--     -- apply (op_equiv _ _).injective,
--     -- ext U,
--     -- induction U using opposite.rec,
--     -- cases U,
--     -- dsimp [pushforward_diagram_to_limit.map], simp { single_pass := tt },
--   end,
--   map_comp' := λ j₁ j₂ j₃ f g,
--   begin sorry
--     -- apply (op_equiv _ _).injective,
--     -- ext U,
--     -- dsimp,
--     -- simp only [map_comp_c_app, id.def, eq_to_hom_op, pushforward_map_app, eq_to_hom_map, assoc,
--     --   id_comp, pushforward.comp_inv_app, pushforward_eq_hom_app],
--     -- dsimp,
--     -- simp only [eq_to_hom_trans, id_comp],
--     -- congr' 1,
--     -- -- The key fact is `(F.map f).c.congr`,
--     -- -- which allows us in rewrite in the argument of `(F.map f).c.app`.
--     -- rw (F.map f).c.congr,
--     -- -- Now we pick up the pieces. First, we say what we want to replace that open set by:
--     -- swap 3,
--     -- refine op ((opens.map (colimit.ι (F ⋙ PresheafedSpace.forget C) j₂)).obj (unop U)),
--     -- -- Now we show the open sets are equal.
--     -- swap 2,
--     -- { apply unop_injective,
--     --   rw ←opens.map_comp_obj,
--     --   congr,
--     --   exact colimit.w (F ⋙ PresheafedSpace.forget C) g, },
--     -- -- Finally, the original goal is now easy:
--     -- swap 2,
--     -- { simp, refl, },
--   end, }

-- variables [∀ X : Top.{v}, has_limits_of_shape Jᵒᵖ (X.presheaf C)]

-- /--
-- Auxiliary definition for `PresheafedSpace.has_colimits`.
-- -/
-- def colimit (F : J ⥤ PresheafedSpace.{v} C) : PresheafedSpace C :=
-- { carrier := colimit (F ⋙ PresheafedSpace.forget C),
--   presheaf := limit (pushforward_diagram_to_colimit F).left_op, }

-- @[simp] lemma colimit_carrier (F : J ⥤ PresheafedSpace.{v} C) :
--   (colimit F).carrier = limits.colimit (F ⋙ PresheafedSpace.forget C) := rfl

-- @[simp] lemma colimit_presheaf (F : J ⥤ PresheafedSpace.{v} C) :
--   (colimit F).presheaf = limit (pushforward_diagram_to_colimit F).left_op := rfl

-- /--
-- Auxiliary definition for `PresheafedSpace.has_colimits`.
-- -/
-- @[simps]
-- def colimit_cocone (F : J ⥤ PresheafedSpace.{v} C) : cocone F :=
-- { X := colimit F,
--   ι :=
--   { app := λ j,
--     { base := colimit.ι (F ⋙ PresheafedSpace.forget C) j,
--       c := limit.π _ (op j), },
--     naturality' := λ j j' f,
--     begin
--       fapply PresheafedSpace.ext,
--       { ext x,
--         exact colimit.w_apply (F ⋙ PresheafedSpace.forget C) f x, },
--       { ext U,
--         induction U using opposite.rec,
--         cases U,
--         dsimp,
--         simp only [PresheafedSpace.id_c_app, eq_to_hom_op, eq_to_hom_map, assoc,
--           pushforward.comp_inv_app],
--         rw ← congr_arg nat_trans.app (limit.w (pushforward_diagram_to_colimit F).left_op f.op),
--         dsimp,
--         simp only [eq_to_hom_op, eq_to_hom_map, assoc, id_comp, pushforward.comp_inv_app],
--         congr,
--         dsimp,
--         simp only [id_comp],
--         simpa, }
--     end, }, }

-- variables [has_limits_of_shape Jᵒᵖ C]

-- namespace colimit_cocone_is_colimit

-- /--
-- Auxiliary definition for `PresheafedSpace.colimit_cocone_is_colimit`.
-- -/
-- def desc_c_app (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) (U : (opens ↥(s.X.carrier))ᵒᵖ) :
--   s.X.presheaf.obj U ⟶
--     (colimit.desc (F ⋙ PresheafedSpace.forget C)
--          ((PresheafedSpace.forget C).map_cocone s) _*
--        limit (pushforward_diagram_to_colimit F).left_op).obj
--       U :=
-- begin
--   refine
--     limit.lift _ { X := s.X.presheaf.obj U, π := { app := λ j, _, naturality' := λ j j' f, _, }} ≫
--       (limit_obj_iso_limit_comp_evaluation _ _).inv,
--   -- We still need to construct the `app` and `naturality'` fields omitted above.
--   { refine (s.ι.app (unop j)).c.app U ≫ (F.obj (unop j)).presheaf.map (eq_to_hom _),
--     dsimp,
--     rw ←opens.map_comp_obj,
--     simp, },
--   { rw (PresheafedSpace.congr_app (s.w f.unop).symm U),
--     dsimp,
--     have w := functor.congr_obj (congr_arg opens.map
--       (colimit.ι_desc ((PresheafedSpace.forget C).map_cocone s) (unop j))) (unop U),
--     simp only [opens.map_comp_obj_unop] at w,
--     replace w := congr_arg op w,
--     have w' := nat_trans.congr (F.map f.unop).c w,
--     rw w',
--     dsimp, simp, dsimp, simp, },
-- end

-- lemma desc_c_naturality (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F)
--   {U V : (opens ↥(s.X.carrier))ᵒᵖ} (i : U ⟶ V) :
--   s.X.presheaf.map i ≫ desc_c_app F s V =
--   desc_c_app F s U ≫ (colimit.desc (F ⋙ forget C)
--     ((forget C).map_cocone s) _* (colimit_cocone F).X.presheaf).map i :=
-- begin
--   dsimp [desc_c_app],
--   ext,
--   simp only [limit.lift_π, nat_trans.naturality, limit.lift_π_assoc, eq_to_hom_map, assoc,
--     pushforward_obj_map, nat_trans.naturality_assoc, op_map,
--     limit_obj_iso_limit_comp_evaluation_inv_π_app_assoc,
--     limit_obj_iso_limit_comp_evaluation_inv_π_app],
--   dsimp,
--   have w := functor.congr_hom (congr_arg opens.map
--     (colimit.ι_desc ((PresheafedSpace.forget C).map_cocone s) (unop j))) (i.unop),
--   simp only [opens.map_comp_map] at w,
--   replace w := congr_arg quiver.hom.op w,
--   rw w,
--   dsimp, simp,
-- end

-- /--
-- Auxiliary definition for `PresheafedSpace.colimit_cocone_is_colimit`.
-- -/
-- def desc (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) : colimit F ⟶ s.X :=
-- { base := colimit.desc (F ⋙ PresheafedSpace.forget C) ((PresheafedSpace.forget C).map_cocone s),
--   c :=
--   { app := λ U, desc_c_app F s U,
--     naturality' := λ U V i, desc_c_naturality F s i } }

-- lemma desc_fac  (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) (j : J) :
--   (colimit_cocone F).ι.app j ≫ desc F s = s.ι.app j :=
-- begin
--   fapply PresheafedSpace.ext,
--   { simp [desc] },
--   { ext,
--     dsimp [desc, desc_c_app],
--     simpa }
-- end

-- end colimit_cocone_is_colimit

-- open colimit_cocone_is_colimit

-- /--
-- Auxiliary definition for `PresheafedSpace.has_colimits`.
-- -/
-- def colimit_cocone_is_colimit (F : J ⥤ PresheafedSpace.{v} C) : is_colimit (colimit_cocone F) :=
-- { desc := λ s, desc F s,
--   fac' := λ s, desc_fac F s,
--   uniq' := λ s m w,
--   begin
--     -- We need to use the identity on the continuous maps twice, so we prepare that first:
--     have t : m.base = colimit.desc (F ⋙ PresheafedSpace.forget C)
--                         ((PresheafedSpace.forget C).map_cocone s),
--     { apply category_theory.limits.colimit.hom_ext, intros j,
--       apply continuous_map.ext, intros x,
--       dsimp,
--       simp only [colimit.ι_desc_apply, map_cocone_ι_app],
--       rw ← w j,
--       simp, },
--     fapply PresheafedSpace.ext, -- could `ext` please not reorder goals?
--     { exact t, },
--     { ext U j, dsimp [desc, desc_c_app],
--       simp only [limit.lift_π, eq_to_hom_op, eq_to_hom_map, assoc,
--         limit_obj_iso_limit_comp_evaluation_inv_π_app],
--       rw PresheafedSpace.congr_app (w (unop j)).symm U,
--       dsimp,
--       have w := congr_arg op (functor.congr_obj (congr_arg opens.map t) (unop U)),
--       rw nat_trans.congr (limit.π (pushforward_diagram_to_colimit F).left_op j) w,
--       simp }
--   end, }

-- instance : has_colimits_of_shape J (PresheafedSpace.{v} C) :=
-- { has_colimit := λ F, has_colimit.mk
--   { cocone     := colimit_cocone F,
--     is_colimit := colimit_cocone_is_colimit F } }

-- instance : preserves_colimits_of_shape J (PresheafedSpace.forget C) :=
-- { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone
--   (colimit_cocone_is_colimit F)
--   begin
--     apply is_colimit.of_iso_colimit (colimit.is_colimit _),
--     fapply cocones.ext,
--     { refl, },
--     { intro j, dsimp, simp, }
--   end }

-- /--
-- When `C` has limits, the category of presheaved spaces with values in `C` itself has colimits.
-- -/
-- instance [has_limits C] : has_colimits (PresheafedSpace.{v} C) :=
-- { has_colimits_of_shape := λ J 𝒥, by exactI
--   { has_colimit := λ F, has_colimit.mk
--     { cocone     := colimit_cocone F,
--       is_colimit := colimit_cocone_is_colimit F } } }

-- /--
-- The underlying topological space of a colimit of presheaved spaces is
-- the colimit of the underlying topological spaces.
-- -/
-- instance forget_preserves_colimits [has_limits C] : preserves_colimits (PresheafedSpace.forget C) :=
-- { preserves_colimits_of_shape := λ J 𝒥, by exactI
--   { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone
--     (colimit_cocone_is_colimit F)
--     begin
--       apply is_colimit.of_iso_colimit (colimit.is_colimit _),
--       fapply cocones.ext,
--       { refl, },
--       { intro j, dsimp, simp, }
--     end } }

-- /--
-- The components of the colimit of a diagram of `PresheafedSpace C` is obtained
-- via taking componentwise limits.
-- -/
-- def colimit_presheaf_obj_iso_componentwise_limit (F : J ⥤ PresheafedSpace.{v} C) [has_colimit F]
--   (U : opens (limits.colimit F).carrier) :
--   (limits.colimit F).presheaf.obj (op U) ≅ limit (componentwise_diagram F U) :=
-- begin
--   refine ((sheaf_iso_of_iso (colimit.iso_colimit_cocone
--     ⟨_, colimit_cocone_is_colimit F⟩).symm).app (op U)).trans _,
--   refine (limit_obj_iso_limit_comp_evaluation _ _).trans (limits.lim.map_iso _),
--   fapply nat_iso.of_components,
--   { intro X,
--     refine ((F.obj (unop X)).presheaf.map_iso (eq_to_iso _)),
--     dsimp only [functor.op, unop_op, opens.map],
--     congr' 2,
--     rw set.preimage_preimage,
--     simp_rw ← comp_app,
--     congr' 2,
--     exact ι_preserves_colimits_iso_inv (forget C) F (unop X) },
--   { intros X Y f,
--     change ((F.map f.unop).c.app _ ≫ _ ≫ _) ≫ (F.obj (unop Y)).presheaf.map _ = _ ≫ _,
--     rw Top.presheaf.pushforward.comp_inv_app,
--     erw category.id_comp,
--     rw category.assoc,
--     erw [← (F.obj (unop Y)).presheaf.map_comp, (F.map f.unop).c.naturality_assoc,
--       ← (F.obj (unop Y)).presheaf.map_comp],
--     congr }
-- end

-- @[simp]
-- lemma colimit_presheaf_obj_iso_componentwise_limit_inv_ι_app (F : J ⥤ PresheafedSpace.{v} C)
--   (U : opens (limits.colimit F).carrier) (j : J) :
--   (colimit_presheaf_obj_iso_componentwise_limit F U).inv ≫ (colimit.ι F j).c.app (op U) =
--     limit.π _ (op j) :=
-- begin
--   delta colimit_presheaf_obj_iso_componentwise_limit,
--   rw [iso.trans_inv, iso.trans_inv, iso.app_inv, sheaf_iso_of_iso_inv, pushforward_to_of_iso_app,
--     congr_app (iso.symm_inv _)],
--   simp_rw category.assoc,
--   rw [← functor.map_comp_assoc, nat_trans.naturality],
--   erw ← comp_c_app_assoc,
--   rw congr_app (colimit.iso_colimit_cocone_ι_hom _ _),
--   simp_rw category.assoc,
--   erw [limit_obj_iso_limit_comp_evaluation_inv_π_app_assoc, lim_map_π_assoc],
--   convert category.comp_id _,
--   erw ← (F.obj j).presheaf.map_id,
--   iterate 2 { erw ← (F.obj j).presheaf.map_comp },
--   congr
-- end

-- @[simp]
-- lemma colimit_presheaf_obj_iso_componentwise_limit_hom_π (F : J ⥤ PresheafedSpace.{v} C)
--   (U : opens (limits.colimit F).carrier) (j : J) :
--     (colimit_presheaf_obj_iso_componentwise_limit F U).hom ≫ limit.π _ (op j) =
--       (colimit.ι F j).c.app (op U) :=
-- by rw [← iso.eq_inv_comp, colimit_presheaf_obj_iso_componentwise_limit_inv_ι_app]

-- end PresheafedSpace

-- end algebraic_geometry


import Quantifiers.main

universe u

example {α : Type u} (a : α) : α :=
by main

example {α : Type u} (P : α → α → Prop) (h : ∃ x, ∀ y, P x y) : ∀ y, ∃ x, P x y :=
by main

example {α : Type u} (P : α → Prop) (Q : α → Prop) (h₁ : ∃ x, P x)
(h₂ : ∀ x, P x → Q x) : ∃ x, Q x :=
by main

example {α β : Type u} (P : α → α → β → α → Prop) (Q : α → α → β → α → Prop)
(b : β) (h₁ : ∀ x, ∃ y, ∀ z w, P x y z w) (h₂ : ∃ x, ∀ y z w, P x y z w → Q x y z w)
: ∃ x y z, ∀ w, Q x y z w :=
by main

example {α₁ α₂ α₃ α₄ α₅ : Type}
  (f₁ : α₁ → α₂ → α₅)
  (a₁ : α₁)
  (f₂ : α₃ → α₄ → α₂)
  (a₂ : α₃)
  (f₃ : α₅ → α₃)
  (f₄ : α₂ → α₄)
  (f₅ : α₃ → α₄) : α₅ :=
by main


import data.vector
import data.fin.vec_notation
import data.list.of_fn

-- This is just some experiments I'm doing, unofficial
-- Anything that works out will go back into compile.lean

variables (R : Type) [has_zero R] [has_one R] [has_add R] [has_mul R]

-- Same thing as `ℕ ⊕ R` TODO: change or keep?
inductive ExprVal
| nat (n : ℕ)
| rval (r : R)

namespace ExprVal
variable {R}

instance : inhabited (ExprVal R) := ⟨nat 0⟩

instance [has_repr R] : has_repr (ExprVal R) :=
⟨λ v, match v with
| (nat n) := "(nat " ++ (repr n) ++ ")"
| (rval r) := "(rval " ++ (repr r) ++ ")"
end⟩

def add : ExprVal R → ExprVal R → ExprVal R
| (nat n₁) (nat n₂) := nat (n₁ + n₂)
| (rval f₁) (rval f₂) := rval (f₁ + f₂)
| _ _ := arbitrary _

def and : ExprVal R → ExprVal R → ExprVal R
| (nat n₁) (nat n₂) := if n₁ = 0 then nat 0 else nat n₂
| _ _ := arbitrary _

def mul : ExprVal R → ExprVal R → ExprVal R
| (nat n₁) (nat n₂) := nat (n₁ * n₂)
| (rval f₁) (rval f₂) := rval (f₁ * f₂)
| _ _ := arbitrary _

def not : ExprVal R → ExprVal R
| (nat n₁) := if n₁ = 0 then nat 1 else nat 0
| _ := arbitrary _

def to_nat : ExprVal R → ℕ
| (nat n₁) := n₁
| _ := default

def eq : ExprVal R → ExprVal R → ExprVal R
| (nat n₁) (nat n₂) := if n₁ = n₂ then nat 1 else nat 0
| _ _ := arbitrary _

def lt : ExprVal R → ExprVal R → ExprVal R
| (nat n₁) (nat n₂) := if n₁ < n₂ then nat 1 else nat 0
| _ _ := arbitrary _

def to_r : ExprVal R → R
| (nat n) := n
| (rval r) := r

def cast_r (v : ExprVal R) : ExprVal R := rval v.to_r

end ExprVal

section Ident

@[reducible] def Ident := string
@[pattern] def Ident.of : string → Ident := id
instance : decidable_eq Ident := infer_instance
instance : has_repr Ident := ⟨id⟩
attribute [irreducible] Ident

inductive IdentVal
| base : ExprVal R → IdentVal
| arr : ∀ (n : ℕ), (fin n → IdentVal) → IdentVal

instance : inhabited (IdentVal R) := ⟨IdentVal.base default⟩

variable {R}
def IdentVal.get : list ℕ → IdentVal R → ExprVal R
| [] (IdentVal.base x) := x
| (idx :: idcs) (IdentVal.arr n vals) :=
  if h : idx < n then (vals ⟨idx, h⟩).get idcs
  else arbitrary _
| _ _ := arbitrary _

@[simp] lemma IdentVal.base_get (r : ExprVal R) :
  (IdentVal.base r).get [] = r := rfl
@[simp] lemma IdentVal.arr_get {n m : ℕ} (vals : fin n → IdentVal R) (h : m < n) (idcs : list ℕ) :
  (IdentVal.arr n vals).get (m :: idcs) = (vals ⟨m, h⟩).get idcs :=
by simp [IdentVal.get, h]

def IdentVal.update (y : ExprVal R) : list ℕ → IdentVal R → IdentVal R
| [] (IdentVal.base x) := IdentVal.base y
| (idx :: idcs) (IdentVal.arr n vals) :=
  if h : idx < n then
    let val' : IdentVal R := (vals ⟨idx, h⟩).update idcs in IdentVal.arr n $ function.update vals ⟨idx, h⟩ val'
  else arbitrary _
| _ _ := arbitrary _

-- TODO: definitional lemmas for update

end Ident

inductive Op
| add | mul | and | or | not | eq | lt | cast_r

namespace Op
instance : has_repr Op := ⟨λ v, match v with
| add := "add"
| mul := "mul"
| and := "and"
| or := "or"
| not := "not"
| eq := "eq"
| lt := "lt"
| cast_r := "cast"
end⟩

@[reducible] def arity : Op → ℕ
| Op.add := 2
| Op.mul := 2
| Op.and := 2
| Op.or := 2
| Op.not := 1
| Op.eq := 2
| Op.lt := 2
| Op.cast_r := 1

variable {R}
def eval : ∀ o : Op, (fin o.arity → ExprVal R) → ExprVal R
| add := λ x, (x 0).add (x 1)
| mul := λ x, (x 0).mul (x 1)
| and := λ x, (x 0).and (x 1)
| or := λ x, ((x 0).not.and $ (x 1).not).not -- TODO
| not := λ x, (x 0).not
| eq := λ x, (x 0).eq (x 1)
| lt := λ x, (x 0).lt (x 1)
| cast_r := λ x, (x 0).cast_r
end Op

variable (R)
inductive Expr
| lit : ExprVal R → Expr
| ident' : ∀ {n : ℕ}, Ident → (fin n → Expr) → Expr
| call : ∀ o : Op, (fin o.arity → Expr) → Expr

notation a ` ⟪+⟫ `:80 b := Expr.call Op.add ![a, b]
notation a ` ⟪*⟫ `:80 b := Expr.call Op.mul ![a, b]
notation a ` ⟪&&⟫ `:80 b := Expr.call Op.and ![a, b]
notation a ` ⟪||⟫ `:80 b := Expr.call Op.or ![a, b]
notation a ` ⟪<⟫ `:80 b := Expr.call Op.lt ![a, b]
notation a ` ⟪=⟫ `:80 b := Expr.call Op.eq ![a, b]

variable {R}
def Expr.eval  (ctx : Ident → IdentVal R) : Expr R → ExprVal R
| (Expr.lit r) := r
| (Expr.ident' i idcs) := (ctx i).get (list.of_fn (λ j, (idcs j).eval.to_nat))
| (Expr.call o args) := o.eval (λ i, (args i).eval)

/-- An identifier with a list of indices -/
variable (R)
structure ExprLoc :=
(i : Ident)
(idcs : list (Expr R))

variable {R}
def ExprLoc.idcs_eval (loc : ExprLoc R) (ctx : Ident → IdentVal R) : list ℕ :=
loc.idcs.map $ ExprVal.to_nat ∘ Expr.eval ctx

def ExprLoc.get (loc : ExprLoc R) (ctx : Ident → IdentVal R) : ExprVal R :=
(ctx loc.i).get (loc.idcs_eval ctx)

def ExprLoc.update (loc : ExprLoc R) (ctx : Ident → IdentVal R) (val : ExprVal R) : Ident → IdentVal R :=
function.update ctx loc.i ((ctx loc.i).update val (loc.idcs_eval ctx))

def Expr.ident (loc : ExprLoc R) : Expr R :=
Expr.ident' loc.i (λ j : fin loc.idcs.length, loc.idcs.nth_le j (fin.is_lt j))

instance has_coe_from_nat : has_coe ℕ (Expr R) := ⟨λ n, Expr.lit $ ExprVal.nat n⟩
instance has_coe_From_R : has_coe R (Expr R) := ⟨λ r, Expr.lit $ ExprVal.rval r⟩

example : Expr R := (0 : ℕ)
example : Expr R := (0 : R)

/-- Pretty print repr of indices; ignores [] (scalar), represents only
    vector indices -/
def idcs_repr (idcs : list string) : string :=
if idcs.length = 0 then "" else "[" ++ ", ".intercalate idcs ++ "]"

def expr_repr [has_repr R] : Expr R → string
| (Expr.lit r) := repr r
| (Expr.ident' i idcs) := repr i ++ idcs_repr (list.of_fn $ λ j, expr_repr (idcs j))
| (Expr.call o args) := (repr o) ++ "(" ++ ", ".intercalate (vector.of_fn (λ i, expr_repr $ args i)).to_list ++ ")"

instance [has_repr R] : has_repr (Expr R) := ⟨expr_repr⟩
instance [has_repr R] : has_repr (ExprLoc R) :=
⟨λ loc, repr loc.i ++ idcs_repr (loc.idcs.map repr)⟩
-- Because ambiguous whether R or ℕ
-- instance : has_zero (Expr R) := ⟨Expr.lit 0⟩
-- instance : has_one (Expr R) := ⟨Expr.lit 1⟩

variable (R)
inductive Prog
| skip : Prog
| store (dst : ExprLoc R) (val : Expr R)
| seq (a : Prog) (b : Prog)
| branch (cond : Expr R) (a : Prog) (b : Prog)
| loop (n : Expr R) (b : Prog)

variable {R}

def prog_repr [has_repr R] : Prog R → list string
| Prog.skip := [";"]
| (Prog.store dst val) := [(repr dst.i) ++ (idcs_repr (dst.idcs.map repr)) ++ " := " ++ (repr val) ++ ";"]
| (Prog.seq a b) := (prog_repr a) ++ (prog_repr b)
| (Prog.branch c a b) := ["if " ++ (repr c)]
    ++ (prog_repr a).map (λ s, "  " ++ s)
    ++ ["else"]
    ++ (prog_repr b).map (λ s, "  " ++ s)
| (Prog.loop n b) := ["for " ++ (repr n) ++ " times"]
    ++ (prog_repr b).map (λ s, "  " ++ s)

instance [has_repr R] : has_to_string (Prog R) := ⟨λ p, "\n".intercalate (prog_repr p)⟩

def Prog.eval : Prog R → (Ident → IdentVal R) → (Ident → IdentVal R)
| Prog.skip ctx := ctx
| (Prog.store dst val) ctx := dst.update ctx (val.eval ctx)
| (Prog.seq a b) ctx := b.eval (a.eval ctx)
| (Prog.branch cond a b) ctx := if (Expr.eval ctx cond).to_nat = 0 then a.eval ctx else b.eval ctx
| (Prog.loop n b) ctx := (nat.iterate b.eval (Expr.eval ctx n).to_nat) ctx

infixr ` <;> `:1 := Prog.seq
notation a ` ::= `:20 c := Prog.store a c
notation x ` ⟬ ` l:(foldr `, ` (h t, list.cons h t) list.nil ` ⟭ `) := (ExprLoc.mk x l)
notation x ` ⟬ `:10000 l:(foldr `, ` (h t, list.cons h t) list.nil ` ⟭ `) := Expr.ident (ExprLoc.mk x l)

--
section example_prog
namespace vars

abbreviation x := Ident.of "x"
abbreviation y := Ident.of "y"
abbreviation z := Ident.of "z"

end vars

open Expr Prog vars

def pow_prog : Prog ℤ :=
z⟬⟭ ::= (1 : ℤ) <;>
loop (y⟬⟭) (z⟬⟭ ::= x⟬⟭ ⟪*⟫ z⟬⟭)

def pow_prog_input (i : Ident) : IdentVal ℤ :=
  if i = x then IdentVal.base (ExprVal.rval 3)
  else if i = y then IdentVal.base (ExprVal.nat 4)
  else arbitrary _

#eval ExprLoc.get z⟬⟭ (pow_prog.eval pow_prog_input)

end example_prog

variable (R)
structure BoundedStreamGen (ι α : Type) :=
(current : ι)
(value : α)
(ready : Expr R)
(next : Prog R)
(empty : Expr R)
(bound : Expr R)
(reset : Prog R)
(initialize : Prog R)

variables {ι α : Type} {R}
def BoundedStreamGen.compile (g : BoundedStreamGen R unit (Prog R)) : Prog R :=
g.reset <;>
Prog.loop g.bound $
  Prog.branch g.ready g.value Prog.skip <;>
  Prog.branch g.empty Prog.skip g.next

def BoundedStreamGen.singleton (a : α) : BoundedStreamGen R unit α :=
{ current := (),
  value := a,
  ready := (1 : ℕ),
  empty := (1 : ℕ),
  bound := (1 : ℕ),
  next := Prog.skip,
  reset := Prog.skip,
  initialize := Prog.skip }

def BoundedStreamGen.expr_to_prog (inp : BoundedStreamGen R unit (Expr R)) : BoundedStreamGen R unit (Prog R) :=
{ current := (),
  value := (Ident.of "output")⟬⟭ ::= inp.value,
  ready := inp.ready,
  next := inp.next,
  empty := inp.empty,
  bound := inp.bound,
  reset := inp.reset,
  initialize := inp.initialize }

section example_singleton

def test : BoundedStreamGen ℤ unit (Expr ℤ) := BoundedStreamGen.singleton (10 : ℤ)

#eval trace_val (to_string test.expr_to_prog.compile)

end example_singleton

def range (n : Expr R) (var : Ident) : BoundedStreamGen R (Expr R) (Expr R) :=
{ current := var⟬⟭,
  value := Expr.call Op.cast_r ![var⟬⟭],
  ready := var⟬⟭ ⟪<⟫ n,
  empty := Expr.call Op.not ![var⟬⟭ ⟪<⟫ n],
  next := var⟬⟭ ::= var⟬⟭ ⟪+⟫ (1 : ℕ),
  reset := var⟬⟭ ::= (0 : ℕ),
  bound := n,
  initialize := var⟬⟭ ::= (0 : ℕ), }

def contraction {ι : Type} (acc : Ident) (v : BoundedStreamGen R ι (Expr R)) :
  BoundedStreamGen R unit (Expr R) :=
{ BoundedStreamGen.singleton (Expr.ident acc⟬⟭) with
  reset := v.reset <;>
    acc⟬⟭ ::= (0 : R) <;>
    Prog.loop v.bound $
      Prog.branch v.ready (acc⟬⟭ ::= acc⟬⟭ ⟪+⟫ v.value) Prog.skip <;>
      Prog.branch v.empty Prog.skip v.next,
  initialize := v.initialize }

def flatten {ι₁ ι₂ α : Type} (outer : BoundedStreamGen R ι₁ (BoundedStreamGen R ι₂ α)) :
  BoundedStreamGen R (ι₁ × ι₂) α :=
let inner := outer.value in
{ current := (outer.current, inner.current),
  value := inner.value,
  ready := outer.ready ⟪&&⟫ inner.ready,
  next := let next_outer := outer.next <;> inner.reset in
  Prog.branch outer.ready
    (Prog.branch inner.empty next_outer inner.next)
    next_outer,
  empty := outer.empty,
  bound := outer.bound ⟪*⟫ inner.bound, -- TODO: fix
  reset := outer.reset <;> inner.reset, -- TODO: fix
  initialize := outer.initialize <;> inner.initialize }

def test₂ : BoundedStreamGen ℤ (Expr ℤ) (Expr ℤ) := range (10 : ℕ) (Ident.of "x")
#eval trace_val $ to_string $ (contraction (Ident.of "acc") test₂).expr_to_prog.compile

def externVec (len : Expr R) (inp : Ident) (inp_idx : Ident) : BoundedStreamGen R (Expr R) (Expr R) :=
{ current := Expr.ident inp_idx⟬⟭,
  value := inp⟬ inp_idx⟬⟭ ⟭,
  ready := inp_idx⟬⟭ ⟪<⟫ len,
  next := inp_idx⟬⟭ ::= inp_idx⟬⟭ ⟪+⟫ (1 : ℕ),
  empty := Expr.call Op.not ![inp_idx⟬⟭ ⟪<⟫ len],
  bound := len,
  reset := inp_idx⟬⟭ ::= (0 : ℕ),
  initialize := inp_idx⟬⟭ ::= (0 : ℕ) }

def externMat (l₁ l₂ : Expr R) (inp idx₁ idx₂ : Ident) : BoundedStreamGen R (Expr R) (BoundedStreamGen R (Expr R) (Expr R)) :=
{ current := Expr.ident idx₁⟬⟭,
  value := { current := Expr.ident idx₂⟬⟭,
    value := inp⟬idx₁⟬⟭, idx₂⟬⟭⟭,
    ready := idx₂⟬⟭ ⟪<⟫ l₂,
    next := idx₂⟬⟭ ::= idx₂⟬⟭ ⟪+⟫ (1 : ℕ),
    empty := Expr.call Op.not ![idx₂⟬⟭ ⟪<⟫ l₂],
    bound := l₂,
    reset := idx₂⟬⟭ ::= (0 : ℕ),
    initialize := idx₂⟬⟭ ::= (0 : ℕ) },
  ready := idx₁⟬⟭ ⟪<⟫ l₁,
  next := idx₁⟬⟭ ::= idx₁⟬⟭ ⟪+⟫ (1 : ℕ),
  empty := Expr.call Op.not ![idx₁⟬⟭ ⟪<⟫ l₁],
  bound := l₁,
  reset := idx₁⟬⟭ ::= (0 : ℕ),
  initialize := idx₁⟬⟭ ::= (0 : ℕ) }

def externSparseMat (l₁ l₂ : Expr R) (vals idx₁ idx₂ i j : Ident) : BoundedStreamGen R (Expr R) (BoundedStreamGen R (Expr R) (Expr R)) :=
{ current := Expr.ident i⟬⟭,
  value := { current := Expr.ident j⟬⟭,
    value := vals⟬ idx₂⟬idx₁⟬i⟬⟭⟭, j⟬⟭⟭ ⟭,
    ready := j⟬⟭ ⟪<⟫ l₂,
    next := j⟬⟭ ::= j⟬⟭ ⟪+⟫ (1 : ℕ),
    empty := Expr.call Op.not ![j⟬⟭ ⟪<⟫ l₂],
    bound := l₂,
    reset := j⟬⟭ ::= (0 : ℕ),
    initialize := j⟬⟭ ::= (0 : ℕ) },
  ready := i⟬⟭ ⟪<⟫ l₁,
  next := i⟬⟭ ::= i⟬⟭ ⟪+⟫ (1 : ℕ),
  empty := Expr.call Op.not ![i⟬⟭ ⟪<⟫ l₁],
  bound := l₁,
  reset := i⟬⟭ ::= (0 : ℕ),
  initialize := i⟬⟭ ::= (0 : ℕ) }

def test₃ : BoundedStreamGen ℤ (Expr ℤ) (Expr ℤ) := externVec (10 : ℕ) (Ident.of "input") (Ident.of "idx")

#eval trace_val $ to_string $ (contraction (Ident.of "acc") test₃).expr_to_prog.compile

def test₄ : BoundedStreamGen ℤ (Expr ℤ) _ := externMat (10 : ℕ) (20 : ℕ) (Ident.of "inp") vars.x vars.y
def test₅ : BoundedStreamGen ℤ (Expr ℤ × Expr ℤ) (Expr ℤ) := flatten test₄

#eval trace_val $ to_string $ (contraction (Ident.of "acc") test₅).expr_to_prog.compile

def test₆ : BoundedStreamGen ℤ (Expr ℤ) _ := externSparseMat (10 : ℕ) (20 : ℕ) (Ident.of "vals") (Ident.of "idx₁") (Ident.of "idx₂") (Ident.of "i") (Ident.of "j")
def test₇ : BoundedStreamGen ℤ (Expr ℤ × Expr ℤ) (Expr ℤ) := flatten test₆

#eval trace_val $ to_string $ (contraction (Ident.of "acc") test₇).expr_to_prog.compile


import for_mathlib.category_theory.localization.derived_functor_functoriality
import for_mathlib.category_theory.functor.shift
import for_mathlib.category_theory.localization.triangulated

open category_theory category_theory.category

noncomputable theory

namespace category_theory

variables {C H D A : Type*} [category C] [category H] [category D] [add_group A]
  [hD : has_shift D A] (F : C ⥤ D) (L : C ⥤ H)
  (W : morphism_property C) [L.is_localization W]
  [F.has_right_derived_functor W] (a : A)

namespace functor

namespace has_comm_shift

include hD

@[simps]
def right_derived_α_shift (a : A) :
  F ⋙ shift_functor D a ⟶ L ⋙ F.right_derived_functor L W ⋙ shift_functor D a :=
whisker_right (F.right_derived_functor_α L W) _  ≫ (functor.associator _ _ _).hom

instance is_right_derived_functor_α_shift :
  (F.right_derived_functor L W ⋙ shift_functor D a).is_right_derived_functor
  (right_derived_α_shift F L W a) :=
by { dsimp only [right_derived_α_shift], apply_instance, }

instance has_right_derived_functor_α_shift :
  (F ⋙ shift_functor D a).has_right_derived_functor W :=
is_right_derived_functor.has_right_derived_functor (F ⋙ shift_functor D a)
  (F.right_derived_functor W.Q W ⋙ shift_functor D a) W.Q (right_derived_α_shift F W.Q W a) W

omit hD

variables [has_shift C A] [has_shift H A] [L.has_comm_shift A]

@[simps]
def right_derived_shift_α (a : A) :
  shift_functor C a ⋙ F ⟶ L ⋙ shift_functor H a ⋙ F.right_derived_functor L W :=
whisker_left _ (F.right_derived_functor_α L W) ≫ (functor.associator _ _ _).inv ≫
  whisker_right (L.comm_shift_iso a).hom _ ≫ (functor.associator _ _ _).hom

instance is_right_derived_functor_shift_α :
  (shift_functor H a ⋙ F.right_derived_functor L W).is_right_derived_functor
  (right_derived_shift_α F L W a) :=
by { dsimp only [right_derived_shift_α], apply_instance, }

variable [hW : W.compatible_with_shift A]
include hW

instance has_right_derived_functor_shift_α :
  (shift_functor C a ⋙ F).has_right_derived_functor W :=
is_right_derived_functor.has_right_derived_functor (shift_functor C a ⋙ F)
  (shift_functor W.localization a ⋙ F.right_derived_functor W.Q W) W.Q (right_derived_shift_α F W.Q W a) W

omit hW
include hD
variable [F.has_comm_shift A]

def right_derived_comm_shift :
  shift_functor H a ⋙ F.right_derived_functor L W ≅
    F.right_derived_functor L W ⋙ shift_functor D a :=
nat_iso.right_derived (F.comm_shift_iso a) (right_derived_shift_α F L W a)
  (right_derived_α_shift F L W a)

@[reassoc]
lemma right_derived_comm_shift_comm (X : C) :
  (right_derived_shift_α F L W a).app X ≫ (right_derived_comm_shift F L W a).hom.app (L.obj X) =
    (F.comm_shift_iso a).hom.app X ≫ (right_derived_α_shift F L W a).app X :=
nat_trans.right_derived_app (F.comm_shift_iso a).hom
  (right_derived_shift_α F L W a) (right_derived_α_shift F L W a) X

@[reassoc]
lemma right_derived_comm_shift_comm' (X : C) :
  (F.right_derived_functor_α L W).app ((shift_functor C a).obj X) ≫
    (F.right_derived_functor L W).map ((L.comm_shift_iso a).hom.app X) ≫
    (right_derived_comm_shift F L W a).hom.app (L.obj X) =
  (F.comm_shift_iso a).hom.app X ≫
    (shift_functor D a).map ((F.right_derived_functor_α L W).app X) :=
by simpa only [right_derived_shift_α_app, assoc, right_derived_α_shift_app]
  using right_derived_comm_shift_comm F L W a X

instance : has_comm_shift (F.right_derived_functor L W) A :=
{ iso := λ a, right_derived_comm_shift F L W a,
  iso_zero := begin
    ext1,
    apply is_right_derived_functor_to_ext _ (right_derived_shift_α F L W (0 : A)),
    ext X,
    simp only [nat_trans.comp_app, whisker_left_app, right_derived_comm_shift_comm],
    simp only [right_derived_α_shift_app, right_derived_shift_α_app, comm_shift.unit_hom_app,
      assoc, L.comm_shift_iso_zero, F.comm_shift_iso_zero, functor.map_comp],
    nth_rewrite 1 ← functor.map_comp_assoc,
    erw [iso.inv_hom_id_app, functor.map_id, id_comp,
      ← (F.right_derived_functor_α L W).naturality_assoc,
      (shift_functor_zero D A).inv.naturality ((F.right_derived_functor_α L W).app X)],
  end,
  iso_add := λ a b, begin
    ext1,
    apply is_right_derived_functor_to_ext _ (right_derived_shift_α F L W (a+b)),
    ext X,
    simp only [nat_trans.comp_app, whisker_left_app, right_derived_comm_shift_comm],
    simp only [right_derived_α_shift_app, right_derived_shift_α_app, comm_shift.add_hom_app,
      assoc, L.comm_shift_iso_add, F.comm_shift_iso_add, functor.map_comp],
    nth_rewrite 3 ← functor.map_comp_assoc,
    erw [iso.inv_hom_id_app, functor.map_id, id_comp],
    erw ← (F.right_derived_functor_α L W).naturality_assoc,
    rw ← (shift_functor_add D a b).inv.naturality,
    erw (right_derived_comm_shift F L W b).hom.naturality_assoc,
    erw right_derived_comm_shift_comm'_assoc F L W b (X⟦a⟧),
    erw ← functor.map_comp_assoc,
    rw ← right_derived_comm_shift_comm' F L W a X,
    simpa only [functor.map_comp, assoc],
  end, }

instance right_derived_functor_α_respects_comm_shift :
  (F.right_derived_functor_α L W).respects_comm_shift A :=
⟨λ a, begin
  ext X,
  simpa only [nat_trans.comp_app, comp_hom_app, right_derived_α_shift_app,
    right_derived_shift_α_app, assoc] using (right_derived_comm_shift_comm F L W a X).symm,
end⟩

end has_comm_shift

end functor

end category_theory


import parlang.defs
import parlang.lemmas_active_map
import parlang.lemmas_thread_state

namespace parlang
namespace state
variables {n : ℕ} {σ : Type} {ι : Type} {τ : ι → Type} [decidable_eq ι]

-- we have to prove all four combinations (2 by contradiction and 2 because they match)
-- there must be at least one thread otherwise memory can be arbitrary
-- todo: do pattern matching to shorten proof?
lemma syncable_unique {s : state n σ τ} {m m'} (h₁ : syncable s m) (h₂ : syncable s m') (hl : 0 < n) : m = m' := begin
  funext,
  specialize h₁ x,
  specialize h₂ x,
  cases h₁,
  case or.inl {
    cases h₂,
    case or.inl {
      have i : fin n := ⟨0, hl⟩,
      rw (h₁ i).right,
      rw (h₂ i).right,
    },
    case or.inr {
      cases h₂ with i h₂,
      specialize h₁ i,
      have : x ∈ (s.threads.nth i).stores := by apply h₂.left,
      have : x ∉ (s.threads.nth i).stores := by apply h₁.left,
      contradiction,
    }
  },
  case or.inr {
    cases h₁ with h₁l h₁,
    cases h₁ with h₁_1 h₁,
    cases h₁ with h₁_2 h₁_3,
    cases h₂,
    case or.inl {
      specialize h₂ h₁l,
      have : x ∉ (vector.nth (s.threads) h₁l).stores := by apply h₂.left,
      contradiction,
    },
    case or.inr {
      cases h₂ with h₂l h₂,
      cases h₂ with h₂_1 h₂,
      cases h₂ with h₂_2 h₂_3,
      rw h₁_2,
      rw h₂_2,
      have hleq : h₁l = h₂l := begin
        by_contra hlneq,
        have : x ∉ thread_state.accesses (vector.nth (s.threads) h₁l) := begin
          specialize h₂_3 h₁l,
          apply h₂_3,
          intro a,
          apply hlneq,
          exact eq.symm a,
        end,
        unfold thread_state.accesses at this,
        have : x ∉ (vector.nth (s.threads) h₁l).stores := begin
          apply set.union_no_mem_left this,
        end,
        contradiction,
      end,
      subst hleq,
    }
  }
end

theorem syncable_tlocal (s : state n σ τ) (m : memory τ) (ac : vector bool n) (tl : thread_state σ τ → σ) : s.syncable m ↔ (s.map_active_threads ac $ λts, { tlocal := tl ts, ..ts }).syncable m := begin
  unfold syncable,
  induction n,
  case nat.zero {
    split, {
      intro h,
      intro i,
      left,
      intro tid,
      apply fin_zero_elim tid,
    }, {
      intros h i,
      left,
      intro tid,
      apply fin_zero_elim tid,
    }
  },
  case nat.succ : n ih {
    split, {
      intros h i,
      specialize h i,
      cases h,
      {
        left,
        intro tid,
        specialize h tid,
        cases h,
        split, {
          sorry,
        },
        sorry
      },
      sorry,
    },
    sorry,
  }
end

@[simp]
lemma compute_stores_state {s : state n σ τ} {ac : vector bool n} {tid} {f g} :
(vector.nth ((map_active_threads ac (thread_state.compute g ∘ f) s).threads) tid).stores = (vector.nth ((map_active_threads ac f s).threads) tid).stores := begin
  unfold map_active_threads,
  simp,
  by_cases h : vector.nth ac tid = tt, {
    simp [*, thread_state.compute],
  }, {
    simp at h,
    simp [*, thread_state.compute],
  }
end

@[simp]
lemma compute_loads_state {s : state n σ τ} {ac : vector bool n} {tid} {f g} :
(vector.nth ((map_active_threads ac (thread_state.compute g ∘ f) s).threads) tid).loads = (vector.nth ((map_active_threads ac f s).threads) tid).loads := begin
  unfold map_active_threads,
  simp,
  by_cases h : vector.nth ac tid = tt, {
    simp [*, thread_state.compute],
  }, {
    simp at h,
    simp [*, thread_state.compute],
  }
end

@[simp]
lemma compute_shared_state {s : state n σ τ} {ac : vector bool n} {tid} {f g} :
(vector.nth ((map_active_threads ac (thread_state.compute g ∘ f) s).threads) tid).shared = (vector.nth ((map_active_threads ac f s).threads) tid).shared := begin
  unfold map_active_threads,
  simp,
  by_cases h : vector.nth ac tid = tt, {
    simp [*, thread_state.compute],
  }, {
    simp at h,
    simp [*, thread_state.compute],
  }
end

@[simp]
lemma compute_access_state {s : state n σ τ} {ac : vector bool n} {tid} {f g} :
thread_state.accesses (vector.nth ((map_active_threads ac (thread_state.compute g ∘ f) s).threads) tid) = thread_state.accesses (vector.nth ((map_active_threads ac f s).threads) tid) := by simp [thread_state.accesses]

@[simp]
lemma syncable_remove_compute {s : state n σ τ} (ac : vector bool n) (f m g) : syncable (map_active_threads ac (thread_state.compute g ∘ f) s) m ↔ syncable (map_active_threads ac f s) m := begin
  simp [syncable, compute_stores_state, compute_shared_state, compute_access_state],
end

lemma state_eq_per_thread {s u : state n σ τ} : (∀ i, s.threads.nth i = u.threads.nth i) → s = u := begin
  intros hieq,
  cases s,
  cases u,
  simp at *,
  apply vector.eq_element_wise hieq,
end

lemma map_active_threads_nth_inac {s : state n σ τ} {ac : vector bool n} {f i} : ¬ ac.nth i → s.threads.nth i = (s.map_active_threads ac f).threads.nth i := begin
  intro hnac,
  unfold map_active_threads,
  simp [hnac],
end

lemma map_active_threads_nth_ac {s : state n σ τ} {ac : vector bool n} {f i} : ac.nth i → (s.map_active_threads ac f).threads.nth i = f (s.threads.nth i) := begin
  intro hac,
  unfold map_active_threads,
  simp [hac],
end

@[simp]
lemma map_map_active_threads {s : state n σ τ} {ac : vector bool n} {f g} : (s.map_active_threads ac f).map_active_threads ac g  = s.map_active_threads ac (g ∘ f) := begin
  simp [map_active_threads],
  rw vector.map₂_map₂,
  apply vector.eq_element_wise,
  intro i,
  simp,
  by_cases h : vector.nth ac i = tt,
  { simp *, },
  { simp at h, simp *, },
end

lemma map_map_active_threads' {s : state n σ τ} {ac : vector bool n} (f g) : (s.map_active_threads ac f).map_active_threads ac g  = s.map_active_threads ac (λ ts, g (f ts)) := begin
  simp [map_active_threads],
  apply vector.eq_element_wise,
  intro,
  simp,
  by_cases h : vector.nth ac i = tt,
  { simp *, },
  { simp at h, simp *, },
end

lemma map_threads_all_threads_active {s : state n σ τ} {ac : vector bool n} {f} (h : all_threads_active ac) : s.map_threads f = s.map_active_threads ac f := begin
  simp [map_active_threads, map_threads],
  apply vector.eq_element_wise,
  intro,
  simp,
  by_cases h' : vector.nth ac i = tt,
  { simp *, },
  {
    unfold all_threads_active list.all at h,
    have : _ := all_threads_active_nth h i,
    contradiction,
  },
end

lemma map_active_threads_id (s : state n σ τ) (ac : vector bool n) : s = s.map_active_threads ac (thread_state.compute id) := begin
  cases s,
  simp [map_active_threads],
  apply vector.eq_element_wise,
  simp,
end

lemma map_active_threads_comm {s : state n σ τ} {ac₁ ac₂ : vector bool n} {f g} (h : ac_distinct ac₁ ac₂) :
  (s.map_active_threads ac₁ f).map_active_threads ac₂ g = (s.map_active_threads ac₂ g).map_active_threads ac₁ f := begin
  simp [map_active_threads],
  apply vector.eq_element_wise,
  intro i,
  repeat { rw vector.nth_map₂},
  cases h i,
  {
    simp[h_1],
    by_cases vector.nth ac₂ i = tt,
    { rw h, },
    { simp at h, simp [h], }
  }, {
    simp[h_1],
    by_cases vector.nth ac₁ i = tt,
    { rw h, },
    { simp at h, simp [h], }
  }
end

lemma map_active_threads_no_thread_active (s : state n σ τ) (ac : vector bool n) (f)
(h : no_thread_active ac) :
s.map_active_threads ac f = s := begin
  unfold map_active_threads,
  cases s,
  simp,
  apply vector.eq_element_wise,
  intro i,
  simp,
  by_cases h' : vector.nth ac i = tt,
  {
    have : _ := no_threads_active_nth h i,
    contradiction,
  }, {
    rw eq_ff_eq_not_eq_tt at h',
    simp *,
  }
end

end state
end parlang


import for_mathlib.ab4
import for_mathlib.AddCommGroup

open category_theory
open category_theory.limits
namespace AddCommGroup

universe u

lemma injective_of_mono' {X Y : Ab.{u}} (f : X ⟶ Y) [mono f] :
  function.injective f :=
by rwa ← AddCommGroup.mono_iff_injective

open_locale classical

noncomputable
def cofan {α : Type (u)} (X : α → Ab.{u}) :
  cofan X :=
cofan.mk
(AddCommGroup.of $ Π₀ x, X x)
(λ a, dfinsupp.single_add_hom (λ x, X x) a)

noncomputable
def is_colimit_cofan {α : Type (u)} (X : α → Ab.{u}) :
  is_colimit (cofan X) :=
{ desc := λ S, dfinsupp.lift_add_hom
    (λ i, let e : X i ⟶ S.X := S.ι.app i in e),
  fac' := λ S j, begin
    dsimp [cofan], ext t,
    simp only [comp_apply, dfinsupp.single_add_hom_apply,
      dfinsupp.sum_add_hom_single],
  end,
  uniq' := begin
    intros S m hm,
    apply_fun dfinsupp.lift_add_hom.symm,
    swap, apply_instance,
    dsimp,
    erw add_equiv.symm_apply_apply, ext1 a,
    rw ← hm,
    ext,
    dsimp [cofan],
    simp only [comp_apply, dfinsupp.single_add_hom_apply],
  end }

instance AB4 : AB4 AddCommGroup.{u} :=
begin
  constructor,
  introsI α X Y f hf,
  let t := _, change mono t,
  let eX : (∐ λ (a : α), X a) ≅ (cofan X).X :=
    (colimit.is_colimit _).cocone_point_unique_up_to_iso (is_colimit_cofan X),
  let eY : (∐ λ (a : α), Y a) ≅ (cofan Y).X :=
    (colimit.is_colimit _).cocone_point_unique_up_to_iso (is_colimit_cofan Y),
  let q : (cofan X).X ⟶ (cofan Y).X :=
    (is_colimit_cofan X).desc ⟨(cofan Y).X,
    λ a, f a ≫ (cofan Y).ι.app a, _⟩,
  swap, { rintros i _ ⟨⟨⟨⟩⟩⟩, dsimp, simp, dsimp, simp },
  haveI : mono q,
  { apply concrete_category.mono_of_injective,
    rintros (u v : Π₀ x, X x) h, ext w,
    dsimp [q, is_colimit_cofan, cofan] at h,
    apply_fun (λ e, (e : Π₀ w, Y w) w) at h,
    simp_rw dfinsupp.sum_add_hom_apply at h,
    apply_fun f w,
    swap,
    { rw ← AddCommGroup.mono_iff_injective, apply_instance },
    let q : Π i, Y i → Π₀ i, Y i := dfinsupp.single,
    let qq : Π i, X i → Π₀ i, Y i := λ i, (q i) ∘ (f i),
    change u.sum (λ i, qq i) w = v.sum (λ i, qq i) w at h,
    rw @dfinsupp.sum_apply α (λ i, Y i) α _ (λ i, X i) _ _ _ u qq w at h,
    rw @dfinsupp.sum_apply α (λ i, Y i) α _ (λ i, X i) _ _ _ v qq w at h,
    simp only [dfinsupp.single_apply] at h,
    dsimp [dfinsupp.sum] at h,
    simp_rw [finset.sum_dite_eq'] at h,
    convert h,
    all_goals
    { split_ifs with hh hh, { refl },
      simp only [dfinsupp.mem_support_to_fun, not_not] at hh,
      simp only [hh, (f w).map_zero] } },
  suffices : t = eX.hom ≫ q ≫ eY.inv,
  { rw this, apply_instance },
  dsimp [t, eX, q, eY],
  apply colimit.hom_ext,
  simp only [colimit.ι_desc, cofan.mk_ι_app,
    is_colimit.cocone_point_unique_up_to_iso_hom_desc_assoc,
    colimit.is_colimit_desc, colimit.ι_desc_assoc, category.assoc,
    is_colimit.comp_cocone_point_unique_up_to_iso_inv, colimit.cocone_ι,
    eq_self_iff_true, implies_true_iff],
end

end AddCommGroup


import model_theory.substructures
import model_theory.bundled

--OUTPUT 1
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let A := λ n : ℕ, ∃ x₁ x₂, x₁ ≠ x₂ ∧ x₁ ≠ x₁ ∧ x₁ ≠ x₃ ∧ x₁ ≠ x₄ ∧ x₁ ≠ x₅ ∧ x₁ ≠ x₆ ∧ x₁ ≠ x₇ ∧ x₁ ≠ x₈ ∧ x₁ ≠ x₉ ∧ x₁ ≠ x₁₀ ∧ x₁ ≠ x₁₁ ∧ x₁ ≠ x₁₂ ∧ x₁ ≠ x₁₃ ∧x₁≠x₁₄ ∧ x₁≠x₁₅ ∧ x₁≠x₁₆ ∧ x₁≠x₁₇ ∧ x₁≠x₁₈ ∧ x₁≠x₁₉ ∧ x₁≠x₂₀ ∧ x₁≠x₂₁ ∧ x₁≠x₂₂ ∧ x₁≠x₂₃ ∧ x₁≠x₂₄ ∧ x₁≠x₂₅ ∧ x₁≠x₂₆ ∧ x₁≠x₂₇ ∧ x₁≠x₂₈ ∧ x₁≠x₂₉ ∧ x₁≠x₃₀ ∧ x₁≠x₃₁ ∧ x₁≠x₃₂ ∧ x₁≠x₃₃ ∧ x₁≠x₃₄ ∧ x₁≠x₃₅ ∧ x₁≠x₃₆ ∧ x₁≠x₃₇ ∧ x₁≠x₃₈ ∧ x₁≠x₃₉ ∧ x₁≠x₄₀ ∧ x₁≠x₄₁ ∧ x₁≠x₄₂ ∧ x₁≠x₄₃ ∧ x₁≠x₄₄ ∧ x₁≠x₄₅ ∧ x₁≠x₄₆ ∧ x₁≠x₄₇ ∧ x₁≠x₄₈ ∧ x₁≠x₄₉ ∧ x₁≠x₅₀ ∧ x₁≠x₅₁ ∧ x₁≠x₅₂ ∧ x₁≠x₅₃ ∧ x₁≠x₅₄ ∧ x₁≠x₅₅ ∧ x₁≠x₅₆ ∧ x₁≠x₅₇ ∧ x₁≠x₅₈ ∧ x₁≠x₅₉ ∧ x₁≠x₆₀ ∧ x₁≠x₆₁ ∧ x₁≠x₆₂ ∧ x₁≠x₆₃ ∧ x₁≠x₆₄ ∧ x₁≠x₆₅ ∧ x₁≠x₆₆ ∧ x₁≠x₆₇ ∧ x₁≠x₆₈ ∧ x₁≠x₆₉ ∧ x₁≠x₇₀ ∧ x₁≠x₇₁ ∧ x₁≠x₇₂ ∧ x₁≠x₇₃ ∧ x₁≠x₇₄ ∧ x₁≠x₇₅ ∧ x₁≠x₇₆ ∧ x₁≠x₇₇ ∧ x₁≠x₇₈ ∧ x₁≠x₇₉ ∧ x₁≠x₈₀ ∧ x₁≠x₈₁ ∧ x₁≠x₈₂ ∧ x₁≠x₈₃ ∧ x₁≠x₈₄ ∧ x₁≠x₈₅ ∧ x₁≠x₈₆ ∧ x₁≠x₈₇ ∧ x₁≠x₈₈ ∧ x₁≠x₈₉ ∧ x₁≠x₉₀ ∧ x₁≠x₉₁ ∧ x₁≠x₉₂ ∧ x₁≠x₉₃ ∧ x₁≠x₉₄ ∧ x₁≠x₉₅ ∧ x₁≠x₉₆ ∧ x₁≠x₉₇ ∧ x₁≠x₉₈ ∧ x₁≠x₉₉ ∧ x₁≠x₁₀₀ ∧ x₁≠x₁₀₁ ∧ x₁≠x₁₀₂ ∧ x₁≠x₁₀₃ ∧ x₁≠x₁₀₄ ∧ x₁≠x₁₀₅ ∧ x₁≠x₁₀₆ ∧ x₁≠x₁₀₇ ∧ x₁≠x₁₀₈ ∧ x₁≠x₁₀₉ ∧ x₁≠x₁₁₀ ∧ x₁≠x₁₁₁ ∧ x₁≠x₁₁₂ ∧ x₁≠x₁₁₃ ∧ x₁≠x₁₁₄ ∧ x₁≠x₁₁₅ ∧ x₁≠x₁₁₆ ∧ x₁≠x₁₁₇ ∧ x₁≠x₁₁₈ ∧ x₁≠x₁₁₉ ∧ x₁≠x₁₂₀ ∧ x₁≠x₁₂₁ ∧ x₁≠x₁₂₂ ∧ x₁≠x₁₂₃ ∧ x₁≠x₁₂₄ ∧ x₁≠x₁₂₅ ∧ x₁≠x₁₂₆ ∧ x₁≠x₁₂₇ ∧ x₁≠x₁
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let A : ℕ → L.Theory,
  assume n,
  have h1 : ∃ (x1 : F.Model), ∃ (x2 : F.Model), ∃ (x3 : F.Model), ∃ (x4 : F.Model), ∃ (x5 : F.Model), ∃ (x6 : F.Model), ∃ (x7 : F.Model), ∃ (x8 : F.Model), ∃ (x9 : F.Model), ∃ (x10 : F.Model), ∃ (x11 : F.Model), ∃ (x12 : F.Model), ∃ (x13 : F.Model), ∃ (x14 : F.Model), ∃ (x15 : F.Model), ∃ (x16 : F.Model), ∃ (x17 : F.Model), ∃ (x18 : F.Model), ∃ (x19 : F.Model), ∃ (x20 : F.Model), ∃ (x21 : F.Model), ∃ (x22 : F.Model), ∃ (x23 : F.Model), ∃ (x24 : F.Model), ∃ (x25 : F.Model), ∃ (x26 : F.Model), ∃ (x27 : F.Model), ∃ (x28 : F.Model), ∃ (x29 : F.Model), ∃ (x30 : F.Model), ∃ (x31 : F.Model), ∃ (x32 : F.Model), ∃ (x33 : F.Model), ∃ (x34 : F.Model), ∃ (x35 : F.Model), ∃ (x36 : F.Model), ∃ (x37 : F.Model), ∃ (x38 : F.Model), ∃ (x39 : F.Model), ∃ (x40 : F.Model), ∃ (x41 : F.Model), ∃ (x42 : F.Model), ∃ (x43 : F.Model), ∃ (x44 : F.Model), ∃ (x45 : F.Model), ∃ (x46 : F.Model), ∃ (x47 : F.Model), ∃ (x48 : F.Model), ∃ (x49 : F.Model), ∃ (x50 : F.Model), ∃ (x51 : F.Model), ∃ (x52 : F.Model), ∃ (x53 : F.Model), ∃ (x54 : F.Model), ∃ (x55 : F.Model), ∃ (x56 : F.Model), ∃ (x57 : F.Model), ∃ (x58 : F.Model), ∃ (x59 : F.Model), ∃ (x60 : F.Model), ∃ (x61 : F.Model), ∃ (x62 : F.Model), ∃ (x63 : F.Model), ∃ (x64 : F.Model), ∃ (x65 : F.Model), ∃ (x66 : F.Model), ∃ (x67 : F.Model), ∃ (x68 : F.Model), ∃ (x69 : F.Model), ∃ (x70 : F.Model), ∃ (x71 : F.Model), ∃ (x72 : F.Model), ∃ (x73 : F.Model), ∃ (x74 : F.Model), ∃ (x75 : F.Model), ∃ (x76 : F.Model), ∃ (x77 : F.Model), ∃ (x78 : F.Model), ∃ (x79 : F.Model), ∃ (x80 : F.Model), ∃ (x81 : F.Model), ∃ (x82 : F.Model), ∃ (x83 : F.Model), ∃ (x84 : F.Model), ∃ (x85 : F.Model), ∃ (x86 : F.Model), ∃ (x87 : F.Model), ∃ (x88 : F.Model), ∃ (x89 : F.Model), ∃ (x90 : F.Model), ∃ (x91 : F.Model), ∃ (x92 : F.Model), ∃ (x93 : F.Model), ∃ (x94 : F.Model), ∃ (x95 : F.Model), ∃ (x96 : F.Model), ∃ (x97 : F.Model), ∃ (x98 : F.Model), ∃ (x99 : F.Model), ∃ (x100 : F.Model), ∃ (x101 : F.Model), ∃ (x102 : F.Model), ∃ (x103 : F.Model), ∃ (x104 : F.Model), ∃ (x105 : F.Model), ∃ (x106 : F.Model), ∃ (x107 : F.Model), ∃ (x108 : F.Model), ∃ (x109 : F.Model), ∃ (x110 : F.Model), ∃ (x111 : F.Model), ∃ (x112 : F.Model), ∃ (x113 : F.Model), ∃ (x114 : F.Model), ∃ (x115 : F.Model), ∃ (x116 : F.Model), ∃ (x117 : F.Model), ∃ (x118 : F.Model), ∃ (x119 : F.Model), ∃ (x120 : F.Model), ∃ (x121 : F.Model), ∃ (x122 : F.Model), ∃ (x123 : F.Model), ∃ (x124 : F.Model), ∃ (x125 : F.Model), ∃ (x126 : F.Model), ∃ (x127 : F.Model), ∃ (x128 : F.Model), ∃ (x129 : F.Model), ∃ (x130 : F.Model), ∃ (x131 : F.Model), ∃ (x132 : F.Model), ∃ (x133 : F.Model), ∃ (x134 : F.Model), ∃ (x135 : F.Model), ∃ (x136 : F.Model), ∃ (x137 : F.Model), ∃ (x138 : F.Model), ∃ (x139 : F.Model), ∃ (x140 : F.Model), ∃ (x141 : F.Model), ∃ (x142 : F.Model), ∃ (x143 : F.Model), ∃ (x144 : F.Model), ∃ (x145 : F.Model), ∃ (x146 : F.Model), ∃ (x147 : F.Model), ∃ (x148 : F.Model), ∃ (x149 : F.Model), ∃ (x150 : F.Model), ∃ (x151 : F.Model), ∃ (x152 : F.Model), ∃ (x153 : F.Model), ∃ (x154 : F.Model), ∃ (x155 : F.Model), ∃ (x156 : F.Model), ∃ (x157 : F.Model), ∃ (x158 : F.Model), ∃ (x159 : F.Model), ∃ (x160 : F.Model), ∃ (x161 : F.Model), ∃ (x162 : F.Model), ∃ (x163 : F.Model), ∃ (x164 : F.Model), ∃ (x165 : F.Model), ∃ (x166 : F.Model), ∃ (x167 : F.Model), ∃ (x168 : F.Model), ∃ (x169 : F.Model), ∃ (x170 : F.Model), ∃ (x171 : F.Model), ∃ (x172 : F.Model), ∃ (x173 : F.Model), ∃ (x174 : F.Model), ∃ (x175 : F.Model), ∃ (x176 : F.Model), ∃ (x177 : F.Model), ∃ (x178 : F.Model), ∃ (x179 : F.Model), ∃ (x180 : F.Model), ∃ (x181 : F.Model), ∃ (x182 : F.Model), ∃ (x183 : F.Model), ∃ (x184 : F.Model), ∃ (x185 : F.Model), ∃ (x186 : F.Model), ∃ (x187 : F.Model), ∃ (x188 : F.Model), ∃ (x189 : F.Model), ∃ (x190 : F.Model), ∃ (x191 : F.Model), ∃ (x192 : F.Model), ∃ (x193 : F.Model), ∃ (x194 : F.Model), ∃ (x195 : F.Model), ∃ (x196 : F.Model), ∃ (x197 : F.Model), ∃ (
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h2 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h2,
  },
  have h2 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h3 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h1 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h3,
  },
  have h3 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h4 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h2 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h4,
  },
  have h4 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h5 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h3 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h5,
  },
  have h5 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h6 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h4 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h6,
  },
  have h6 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h7 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h5 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h7,
  },
  have h7 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h8 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h6 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h8,
  },
  have h8 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h9 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h7 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h9,
  },
  have h9 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h10 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h8 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h10,
  },
  have h10 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h11 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h9 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h11,
  },
  have h11 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h12 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h10 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h12,
  },
  have h12 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h13 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h11 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h13,
  },
  have h13 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h14 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h12 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h14,
  },
  have h14 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h15 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h13 n,
    show ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h15,
  },
  have h15 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin := by {
    assume n : ℕ,
    have h16 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h14 n
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

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

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

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

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

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

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

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

So $F$ has an infinite model.

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