import for_mathlib.algebra.homology.derivability_structure_injective
import for_mathlib.category_theory.abelian.extensions_derived_category

noncomputable theory

open category_theory category_theory.category category_theory.limits

namespace category_theory

namespace short_complex

variables {C : Type*} [category C] [preadditive C] [balanced C]

lemma five_lemma.is_iso_τ₁ {S₁ S₂ : short_complex C} (f : S₁ ⟶ S₂)
  (ex₁ : S₁.exact) [is_iso f.τ₂] [mono f.τ₃] [mono S₁.f] [mono S₂.f] :
  is_iso f.τ₁ :=
begin
  refine ⟨⟨short_complex.exact.lift ex₁ (S₂.f ≫ inv f.τ₂) _, _, _⟩⟩,
  { rw [← cancel_mono f.τ₃, assoc, assoc, ← f.comm₂₃, is_iso.inv_hom_id_assoc,
    S₂.zero, zero_comp], },
  { rw [← cancel_mono (S₁.f), assoc, short_complex.exact.lift_f, f.comm₁₂_assoc,
      is_iso.hom_inv_id, comp_id, id_comp], },
  { rw [← cancel_mono (S₂.f), assoc, f.comm₁₂, short_complex.exact.lift_f_assoc, assoc,
    is_iso.inv_hom_id, comp_id, id_comp], },
end

end short_complex

variables {C D : Type*} [category C] [category D] [abelian C] [abelian D]
  (F : C ⥤ D) [functor.additive F]

namespace injective_embedding

variables [enough_injectives C] (X : C)

def short_complex : short_complex C :=
short_complex.mk (injective.ι X) (cokernel.π (injective.ι X)) (by simp)

instance injective_short_complex_X₂ : injective (short_complex X).X₂ :=
by { dsimp [short_complex], apply_instance, }

instance : mono (short_complex X).f :=
by { dsimp [short_complex], apply_instance, }

instance : epi (short_complex X).g :=
by { dsimp [short_complex], apply_instance, }

lemma short_exact : (short_complex X).short_exact :=
short_complex.short_exact.of_g_is_cokernel (cokernel_is_cokernel _)

end injective_embedding

namespace functor

section

variables {ι : Type*} (c : complex_shape ι) (n : ι)

def single_comp_map_homological_complex_app [decidable_eq ι] (X : C) :
  (F.map_homological_complex c).obj ((homological_complex.single C c n).obj X) ≅
    (homological_complex.single D c n).obj (F.obj X) :=
homological_complex.hom.iso_of_components
(λ i, begin
  by_cases i = n,
  { exact eq_to_iso (by { dsimp, simp only [if_pos h], }), },
  { dsimp,
    simp only [if_neg h],
    exact F.map_zero_object, },
end)
(λ i j hij, begin
  dsimp,
  simp only [F.map_zero, zero_comp, comp_zero],
end)

def single_comp_map_homological_complex [decidable_eq ι] :
  homological_complex.single C c n ⋙ F.map_homological_complex c ≅
    F ⋙ homological_complex.single D c n :=
nat_iso.of_components (F.single_comp_map_homological_complex_app c n)
(λ X Y f, begin
  ext i,
  dsimp [single_comp_map_homological_complex_app],
  by_cases i = n,
  { simp only [dif_pos h, map_comp, eq_to_iso.hom, assoc, eq_to_hom_trans_assoc,
      eq_to_hom_map, eq_to_hom_trans], },
  { simp only [dif_neg h, F.map_zero, zero_comp, comp_zero], },
end)

variable {c}

lemma _root_.homotopy_category_quotient_map_functor_map_homological_complex
  {K L : homological_complex C c} (f : K ⟶ L) (F : C ⥤ D) [F.additive] :
  (homotopy_category.quotient D c).map ((F.map_homological_complex c).map f) =
    (map_homotopy_category c F).map ((homotopy_category.quotient C c).map f) :=
begin
  apply homotopy_category.eq_of_homotopy,
  apply F.map_homotopy,
  apply homotopy_category.homotopy_of_eq,
  simp only [homotopy_category.quotient_map_out],
end

end

instance map_is_strictly_ge (X : cochain_complex C ℤ) (n : ℤ) [X.is_strictly_ge n] :
  cochain_complex.is_strictly_ge ((F.map_homological_complex _ ).obj X) n :=
⟨λ i hi, is_zero.of_iso (is_zero_zero D)
  (F.map_iso (cochain_complex.is_strictly_ge.is_zero X n i hi).iso_zero ≪≫ F.map_zero_object)⟩

lemma _root_.cochain_complex.is_plus.map {X : cochain_complex C ℤ} (h : X.is_plus)
  (F : C ⥤ D) [functor.additive F] :
  cochain_complex.is_plus ((map_homological_complex F (complex_shape.up ℤ)).obj X) :=
begin
  obtain ⟨n, hn⟩ := h,
  haveI := hn,
  exact ⟨n, infer_instance⟩,
end

def map_homotopy_category_factors :
  homotopy_category.quotient _ _ ⋙ map_homotopy_category (complex_shape.up ℤ) F ≅
    F.map_homological_complex _ ⋙ homotopy_category.quotient _ _ :=
nat_iso.of_components (λ K, iso.refl _)
(λ K L f, begin
  dsimp only [iso.refl, functor.comp_map],
  rw [id_comp, comp_id],
  apply homotopy_category.eq_of_homotopy,
  apply F.map_homotopy,
  apply homotopy_category.homotopy_of_eq,
  simp only [homotopy_category.quotient_map_out],
end)

instance map_homotopy_category_has_comm_shift :
  (functor.map_homotopy_category (complex_shape.up ℤ) F).has_comm_shift ℤ :=
@quotient.has_comm_shift _ _ _ _ _ _ _ F.map_homotopy_category_factors ℤ
  _ _ _ (infer_instance : has_shift (homotopy_category C (complex_shape.up ℤ)) ℤ)
  (infer_instance : (homotopy_category.quotient _ _).has_comm_shift ℤ) _

instance : nat_trans.respects_comm_shift F.map_homotopy_category_factors.hom ℤ :=
⟨λ n, begin
  ext K,
  dsimp only [map_homotopy_category_factors, nat_iso.of_components, whisker_right,
    nat_trans.comp_app, iso.refl, whisker_left],
  erw [functor.map_id, comp_id, id_comp],
  apply homotopy_category.eq_of_homotopy,
  erw [id_comp, id_comp, id_comp, id_comp, id_comp, id_comp, id_comp, id_comp,
    comp_id, comp_id, comp_id],
  apply homotopy_category.homotopy_of_eq,
  simp only [functor.map_comp, homotopy_category.quotient_map_out,
    homotopy_category_quotient_map_functor_map_homological_complex, iso.symm_hom,
    ← functor.map_comp_assoc],
  erw [← functor.map_comp, iso.hom_inv_id_app, functor.map_id, id_comp],
end⟩

def map_homotopy_category_plus : homotopy_category.plus C ⥤ homotopy_category.plus D :=
full_subcategory.lift _ (homotopy_category.plus.ι ⋙ functor.map_homotopy_category _ F)
  (λ K, cochain_complex.is_plus.map K.2 F)

def map_homotopy_category_plus_factors :
  F.map_homotopy_category_plus ⋙ homotopy_category.plus.ι ≅
    homotopy_category.plus.ι ⋙ functor.map_homotopy_category _ F :=
full_subcategory.lift_comp_inclusion _ _ _

instance map_homotopy_category_is_triangulated :
  (map_homotopy_category (complex_shape.up ℤ) F).is_triangulated :=
⟨λ T hT, begin
  rw homotopy_category.triangle_distinguished_iff at hT ⊢,
  obtain ⟨K, L, f, ⟨e⟩⟩ := hT,
  exact ⟨_, _, (F.map_homological_complex _).map f,
    ⟨(map_homotopy_category (complex_shape.up ℤ) F).map_triangle.map_iso e ≪≫
    (map_triangle_comp (homotopy_category.quotient C (complex_shape.up ℤ))
    (map_homotopy_category (complex_shape.up ℤ) F)).symm.app _ ≪≫
    (map_triangle_nat_iso F.map_homotopy_category_factors).app _ ≪≫
    (map_triangle_comp (F.map_homological_complex (complex_shape.up ℤ))
    (homotopy_category.quotient D (complex_shape.up ℤ))).app _ ≪≫
    (homotopy_category.quotient D (complex_shape.up ℤ)).map_triangle.map_iso
      (cochain_complex.mapping_cone.triangle_map_iso f F)⟩⟩,
end⟩

instance map_homotopy_category_plus_has_comm_shift :
  (functor.map_homotopy_category_plus F).has_comm_shift ℤ :=
by { dsimp only [map_homotopy_category_plus], apply_instance, }

instance map_homotopy_category_plus_is_triangulated :
  (functor.map_homotopy_category_plus F).is_triangulated :=
by { dsimp only [map_homotopy_category_plus], apply_instance, }

variable [hF : (functor.map_homotopy_category_plus F ⋙
    derived_category.plus.Qh).has_right_derived_functor
    (triangulated.subcategory.W (homotopy_category.plus.acyclic C))]

include hF

abbreviation right_derived_functor_plus : derived_category.plus C ⥤ derived_category.plus D :=
  (functor.map_homotopy_category_plus F ⋙
    derived_category.plus.Qh).right_derived_functor derived_category.plus.Qh
      (triangulated.subcategory.W (homotopy_category.plus.acyclic C))

def right_derived_functor_plus_αh :
  functor.map_homotopy_category_plus F ⋙
    derived_category.plus.Qh ⟶ derived_category.plus.Qh ⋙
      right_derived_functor_plus F :=
functor.right_derived_functor_α _ _ _

def abelian_right_derived_functor (n : ℕ) : C ⥤ D :=
derived_category.plus.single_functor C 0 ⋙ right_derived_functor_plus F ⋙
  derived_category.plus.homology_functor D (n : ℤ)

instance abelian_right_derived_functor_additive (n : ℕ)
  [F.right_derived_functor_plus.is_triangulated] :
  (F.abelian_right_derived_functor n).additive :=
by { dsimp only [abelian_right_derived_functor], apply_instance, }

omit hF

instance single_functor_is_termwise_injective (X : C) (n : ℤ) [injective X] :
  ((homotopy_category.plus.single_functor C n).obj X).obj.as.is_termwise_injective :=
begin
  change ((homological_complex.single C (complex_shape.up ℤ) n).obj X).is_termwise_injective,
  apply_instance,
end

instance (X : homotopy_category.plus C) [X.obj.as.is_termwise_injective]
  [enough_injectives C] :
  is_iso (F.right_derived_functor_plus_αh.app X) :=
by { dsimp only [right_derived_functor_plus_αh], apply_instance, }

def map_homotopy_plus_single_functor_homology_iso_zero :
  F ≅ homotopy_category.plus.single_functor C 0 ⋙ F.map_homotopy_category_plus ⋙
    derived_category.plus.Qh ⋙ derived_category.plus.homology_functor D 0 :=
begin
  change F ≅ homotopy_category.plus.single_functor C 0 ⋙ F.map_homotopy_category_plus ⋙
    derived_category.plus.Qh ⋙ derived_category.plus.ι ⋙ derived_category.homology_functor D 0,
  refine F.right_unitor.symm ≪≫
    iso_whisker_left F (homological_complex.single_homology_functor_iso D (complex_shape.up ℤ) 0).symm ≪≫
    (functor.associator _ _ _).symm ≪≫
    iso_whisker_right (F.single_comp_map_homological_complex (complex_shape.up ℤ) 0).symm
      (homology_functor D (complex_shape.up ℤ) 0) ≪≫
    functor.associator _ _ _ ≪≫ iso_whisker_left _ _ ≪≫ (functor.associator _ _ _).symm ≪≫
    iso_whisker_right (homotopy_category.plus.single_functor_factors C 0).symm _ ≪≫
    functor.associator _ _ _ ≪≫ iso_whisker_left _ (functor.associator _ _ _).symm ≪≫
    iso_whisker_left _ (iso_whisker_right (F.map_homotopy_category_plus_factors).symm _
      ≪≫ functor.associator _ _ _ ≪≫ iso_whisker_left _ (functor.associator _ _ _).symm) ≪≫
    iso_whisker_left _ (iso_whisker_left _
      (iso_whisker_right (derived_category.plus.Qh_comp_ι_iso D).symm
      (derived_category.homology_functor D 0) ≪≫ functor.associator _ _ _)),
  refine iso_whisker_left _ _ ≪≫ (functor.associator _ _ _).symm ≪≫
    iso_whisker_right F.map_homotopy_category_factors.symm _ ≪≫
    functor.associator _ _ _,
  refine (homotopy_category.homology_factors D (complex_shape.up ℤ) 0).symm ≪≫
    iso_whisker_left _ (derived_category.homology_functor_factors_Qh D 0).symm,
end

instance derived_category_plus_single_functor_obj_obj_is_ge (X : C) (n : ℤ) :
  ((derived_category.plus.single_functor C n).obj X).obj.is_ge n :=
begin
  change ((derived_category.single_functor C n).obj X).is_ge n,
  apply_instance,
end

include hF

instance right_derived_functor_plus_obj_is_ge [enough_injectives C]
  (K : derived_category.plus C) (n : ℤ) [K.obj.is_ge n] :
  (F.right_derived_functor_plus.obj K).obj.is_ge n :=
begin
  obtain ⟨K', hK', ⟨e⟩⟩ := derived_category.exists_iso_Q_obj_of_ge K.obj n,
  haveI := hK',
  obtain ⟨Z, hZ, f, hf, hZ'⟩ := homotopy_category.plus.termwise_injective.right_resolution_exists K' n,
  let Z' : homotopy_category.plus C :=
    ⟨(homotopy_category.quotient _ _).obj Z, ⟨n, hZ⟩⟩,
  haveI : Z'.obj.as.is_termwise_injective := hZ',
  let e' : K ≅ derived_category.plus.Qh.obj Z' :=
    derived_category.plus.ι.preimage_iso (e ≪≫ as_iso (derived_category.Q.map f)),
  have e'' := (derived_category.Qh.map_iso ((map_homotopy_category_factors F).app Z)).symm ≪≫
    (derived_category.Qh.map_iso (F.map_homotopy_category_plus_factors.app Z')).symm ≪≫
    (derived_category.plus.Qh_comp_ι_iso D).symm.app
    (F.map_homotopy_category_plus.obj Z') ≪≫ derived_category.plus.ι.map_iso
    (as_iso (F.right_derived_functor_plus_αh.app Z')) ≪≫
    ((F.right_derived_functor_plus ⋙ derived_category.plus.ι).map_iso e'.symm),
  erw ← derived_category.is_ge.iff_of_iso e'' n,
  change (derived_category.Q.obj _).is_ge n,
  apply_instance,
end

def abelian_right_derived_functor_α : F ⟶ F.abelian_right_derived_functor 0 :=
begin
  refine _ ≫ whisker_right (whisker_left (homotopy_category.plus.single_functor C 0)
    F.right_derived_functor_plus_αh) (derived_category.plus.homology_functor D 0) ≫ 𝟙 _,
  { exact F.map_homotopy_plus_single_functor_homology_iso_zero.hom, },
end

lemma abelian_right_derived_functor_α_app (X : C) :
  F.abelian_right_derived_functor_α.app X =
  F.map_homotopy_plus_single_functor_homology_iso_zero.hom.app X ≫
    (derived_category.plus.homology_functor D 0).map
      (F.right_derived_functor_plus_αh.app ((homotopy_category.plus.single_functor C 0).obj X)) :=
begin
  dsimp only [abelian_right_derived_functor_α, whisker_right, whisker_left,
    nat_trans.comp_app, nat_trans.id_app],
  rw comp_id,
end

instance is_iso_abelian_right_derived_functor_plus_α_app (X : C) [injective X] [enough_injectives C] :
  is_iso (F.abelian_right_derived_functor_α.app X) :=
begin
  rw abelian_right_derived_functor_α_app,
  apply_instance,
end

lemma abelian_right_derived_functor_obj_is_zero_of_injective'
  (X : C) [injective X] [enough_injectives C] (n : ℕ) (hn : 1 ≤ n) :
  limits.is_zero ((F.abelian_right_derived_functor n).obj X) :=
begin
  refine is_zero.of_iso _ (((derived_category.plus.homology_functor D n).map_iso
    (as_iso (F.right_derived_functor_plus_αh.app
      ((homotopy_category.plus.single_functor C 0).obj X)))).symm),
  have h : limits.is_zero ((derived_category.homology_functor D n).obj
    ((derived_category.single_functor D 0).obj (F.obj X))),
  { apply derived_category.is_le.is_zero _ 0,
    rw ← int.coe_nat_le_coe_nat_iff at hn,
    rw [algebra_map.coe_one] at hn,
    linarith, },
  refine is_zero.of_iso h ((derived_category.homology_functor D ↑n).map_iso _),
  let e : homotopy_category.plus.single_functor C 0 ⋙ F.map_homotopy_category_plus ⋙
    derived_category.plus.Qh ⋙ derived_category.plus.ι ≅ F ⋙ derived_category.single_functor D 0,
  { refine iso_whisker_left _ (iso_whisker_left _ (derived_category.plus.Qh_comp_ι_iso D)) ≪≫
      iso_whisker_left _ ((functor.associator _ _ _).symm ≪≫
      iso_whisker_right F.map_homotopy_category_plus_factors derived_category.Qh) ≪≫
      iso_whisker_left _ (functor.associator _ _ _) ≪≫
      (functor.associator _ _ _).symm ≪≫
      iso_whisker_right (homotopy_category.plus.single_functor_factors C 0)
        (map_homotopy_category (complex_shape.up ℤ) F ⋙ derived_category.Qh) ≪≫
      functor.associator _ _ _ ≪≫
      iso_whisker_left _ ((functor.associator _ _ _).symm ≪≫
      iso_whisker_right F.map_homotopy_category_factors _) ≪≫
      iso_whisker_left _ (functor.associator _ _ _) ≪≫
      (functor.associator _ _ _).symm ≪≫
      iso_whisker_right (F.single_comp_map_homological_complex (complex_shape.up ℤ) 0) derived_category.Q, },
  exact e.app _,
end

lemma abelian_right_derived_functor_obj_is_zero_of_injective (X : C)
  [injective X] [enough_injectives C] (n : ℕ) :
  limits.is_zero ((F.abelian_right_derived_functor (n+1)).obj X) :=
abelian_right_derived_functor_obj_is_zero_of_injective' _ _ _ (by linarith)

namespace abelian_right_derived_functor_homology_sequence

variables {S : short_complex C} (ex : S.short_exact) (n : ℕ )

def triangle : pretriangulated.triangle (derived_category.plus D) :=
F.right_derived_functor_plus.map_triangle.obj (derived_category.plus.triangle_of_ses
  (short_complex.short_exact.map_of_exact ex (homological_complex.single C (complex_shape.up ℤ) 0))
  (by { dsimp, exact ⟨0, infer_instance⟩, })
  (by { dsimp, exact ⟨0, infer_instance⟩, })
  (by { dsimp, exact ⟨0, infer_instance⟩, }))

def triangle' : pretriangulated.triangle (derived_category D) :=
derived_category.plus.ι.map_triangle.obj (triangle F ex)

variable [hF' : F.right_derived_functor_plus.is_triangulated]

include hF'

lemma triangle_mem : (triangle F ex).distinguished :=
F.right_derived_functor_plus.map_distinguished _
  (derived_category.plus.triangle_of_ses_dist _ _ _ _)

lemma triangle'_mem : (triangle' F ex).distinguished :=
derived_category.plus.ι.map_distinguished _ (triangle_mem F ex)

lemma ex₂ (n : ℕ) :
  (short_complex.mk ((F.abelian_right_derived_functor n).map S.f)
    ((F.abelian_right_derived_functor n).map S.g)
    (by { rw [← functor.map_comp, S.zero, functor.map_zero], })).exact :=
derived_category.homology_sequence.ex₂ (triangle'_mem F ex) n

def δ (n₀ n₁ : ℕ) (h : n₁ = n₀+1) :
  (F.abelian_right_derived_functor n₀).obj S.X₃ ⟶ (F.abelian_right_derived_functor n₁).obj S.X₁ :=
derived_category.homology_sequence.δ (triangle'_mem F ex) n₀ n₁ (by simp [h])

@[simp, reassoc]
lemma δ_comp (n₀ n₁ : ℕ) (h : n₁ = n₀+1) :
  δ F ex n₀ n₁ h ≫ (F.abelian_right_derived_functor n₁).map S.f = 0 :=
derived_category.homology_sequence.δ_comp (triangle'_mem F ex) n₀ n₁ (by simp [h])

@[simp, reassoc]
lemma comp_δ (n₀ n₁ : ℕ) (h : n₁ = n₀+1) :
   (F.abelian_right_derived_functor n₀).map S.g ≫ δ F ex n₀ n₁ h = 0 :=
derived_category.homology_sequence.comp_δ (triangle'_mem F ex) n₀ n₁ (by simp [h])

lemma ex₃ (n₀ n₁ : ℕ) (h : n₁ = n₀+1) :
  (short_complex.mk ((F.abelian_right_derived_functor n₀).map S.g) (δ F ex n₀ n₁ h)
    (by simp)).exact :=
derived_category.homology_sequence.ex₃ (triangle'_mem F ex) n₀ n₁ (by simp [h])

lemma ex₁ (n₀ n₁ : ℕ) (h : n₁ = n₀+1) :
  (short_complex.mk (δ F ex n₀ n₁ h) ((F.abelian_right_derived_functor n₁).map S.f)
    (by simp)).exact :=
derived_category.homology_sequence.ex₁ (triangle'_mem F ex) n₀ n₁ (by simp [h])

include ex

lemma ex₀
  [(F.right_derived_functor_plus.obj
 ((derived_category.plus.single_functor C 0).obj S.X₃)).obj.is_ge 0] :
  mono ((F.abelian_right_derived_functor 0).map S.f) :=
begin
  refine (short_complex.exact_iff_mono _ (is_zero.eq_of_src _ _ _)).1
    (derived_category.homology_sequence.ex₁ (triangle'_mem F ex) (-1) 0 (neg_add_self 1).symm),
  have h := derived_category.is_ge.is_zero ((F.right_derived_functor_plus.obj
   ((derived_category.plus.single_functor C 0).obj S.X₃)).obj) 0 (-1) (by simp),
  exact h,
end

omit ex
omit hF'

instance (X : C) [F.preserves_monomorphisms] [enough_injectives C]:
  mono (F.abelian_right_derived_functor_α.app X) :=
begin
  suffices : mono (F.abelian_right_derived_functor_α.app X ≫
    (F.abelian_right_derived_functor 0).map (injective.ι X)),
  { haveI := this,
    exact mono_of_mono _ ((F.abelian_right_derived_functor 0).map (injective.ι X)), },
  rw ← nat_trans.naturality,
  apply_instance,
end

instance (X : C) [preserves_finite_limits F] [enough_injectives C] :
  is_iso (F.abelian_right_derived_functor_α.app X) :=
begin
  haveI : mono ((injective_embedding.short_complex X).map (F.abelian_right_derived_functor 0)).f :=
    ex₀ F (injective_embedding.short_exact X),
  haveI : mono ((injective_embedding.short_complex X).map F).f,
  { dsimp, apply_instance, },
  let f := short_complex.map_nat_trans (injective_embedding.short_complex X)
    F.abelian_right_derived_functor_α,
  haveI : mono f.τ₃ := (infer_instance : mono (F.abelian_right_derived_functor_α.app _)),
  haveI : is_iso f.τ₂ := (infer_instance : is_iso (F.abelian_right_derived_functor_α.app _)),
  refine short_complex.five_lemma.is_iso_τ₁ f _,
  apply short_complex.exact.of_f_is_kernel,
  let e : parallel_pair (injective_embedding.short_complex X).g 0 ⋙ F ≅
    parallel_pair (F.map (injective_embedding.short_complex X).g) 0 :=
    parallel_pair.ext (iso.refl _) (iso.refl _) (by tidy) (by tidy),
  equiv_rw (limits.is_limit.postcompose_inv_equiv e _).symm,
  refine limits.is_limit.of_iso_limit
    (is_limit_of_preserves F ((injective_embedding.short_exact X).exact.f_is_kernel))
    (cones.ext (iso.refl _) _),
  rintro (_|_),
  { tidy, },
  { dsimp,
    simp only [short_complex.zero, functor.map_zero, comp_id, id_comp,
      ← F.map_comp], },
end

instance [preserves_finite_limits F] [enough_injectives C] :
  is_iso F.abelian_right_derived_functor_α :=
nat_iso.is_iso_of_is_iso_app _

end abelian_right_derived_functor_homology_sequence

end functor

end category_theory


import Runtime.Reaction
import Runtime.Reactor

structure Network.Graph where
  classes : Type
  schemes : classes → (Reactor.Scheme classes)
  [decEqClasses : DecidableEq classes]

attribute [instance] Network.Graph.decEqClasses

namespace Network.Graph

def Class (graph : Graph) := graph.classes

namespace Class

instance : DecidableEq (Class graph) :=
  fun cls₁ cls₂ =>
    let c₁ : graph.classes := cls₁
    let c₂ : graph.classes := cls₂
    if h : c₁ = c₂ then isTrue h else isFalse h

private def scheme (cls : Class graph) := graph.schemes cls

abbrev interface (cls : Class graph) := cls.scheme.interface

abbrev timers (cls : Class graph) := cls.scheme.timers

structure Child (cls : Class graph) where
  id : cls.scheme.children
  deriving DecidableEq

def Child.class {cls : Class graph} (child : Child cls) : Class graph :=
  cls.scheme.class child.id

-- TODO: Get this coercion to work at call site.
instance {cls : Class graph} : Coe (Child cls) (Class graph) where
  coe child := child.class

abbrev subinterface (cls : Class graph) (kind : Reactor.InterfaceKind) :=
  ⨄ fun child : Child cls => child.class.interface kind

abbrev reactionInputScheme (cls : Class graph) :=
  let localInputs := cls.interface .inputs
  let nestedOutputs := cls.subinterface .outputs
  localInputs ⊎ nestedOutputs

@[simp]
theorem reactionInputScheme_type_left {cls : Class graph} (localInput) :
  cls.reactionInputScheme.type (.inl localInput) = (cls.interface .inputs).type localInput := rfl

@[simp]
theorem reactionInputScheme_type_right {cls : Class graph} (child childOutput) :
  cls.reactionInputScheme.type (.inr ⟨child, childOutput⟩) = (child.class.interface .outputs).type childOutput := by
  simp [Interface.Scheme.bUnion_type]

abbrev reactionOutputScheme (cls : Class graph) :=
  let localOutputs := cls.interface .outputs
  let nestedInputs := cls.subinterface .inputs
  localOutputs ⊎ nestedInputs

open Interface in
structure Reaction (cls : Class graph) where
  val : Reaction
  [subPS : Subscheme val.portSources cls.reactionInputScheme]
  [subPE : Subscheme val.portEffects cls.reactionOutputScheme]
  [subAS : Subscheme val.actionSources (cls.interface .actions)]
  [subAE : Subscheme val.actionEffects (cls.interface .actions)]
  eqState  : cls.interface .state = val.state   := by rfl
  eqParams : cls.interface .params = val.params := by rfl
  eqTimers : cls.timers = val.timers            := by rfl

open Reaction in
attribute [instance] subPS subPE subAS subAE

structure Subport (cls : Class graph) (kind : Reactor.PortKind) where
  child : Child cls
  port  : (child.class.interface kind).vars
  deriving DecidableEq

abbrev Subport.type (subport : Subport cls kind) : Type :=
  (subport.child.class.interface kind).type subport.port

structure Connections.DelayedDestination {cls : Class graph} (src : Subport cls .output) where
  dst    : Subport cls .input
  delay  : Duration
  eqType : src.type = dst.type := by rfl

-- The data layout of this type is motivated by execution-specific use cases:
-- * Non-delayed connections are used in a context where a destination
--   port needs to find its corresponding source port (if it exists).
-- * Delayed connections are used in a context where a given source
--   port needs to enumerate all of its delayed destinations.
--
-- Note: We're not to enforcing uniqueness of connections to input ports,
--       as this is handled by the LF frontend.
open Connections in
structure Connections (cls : Class graph) where
  instantaneous : (Subport cls .input) → Option (Subport cls .output)
  delayed       : (src : Subport cls .output) → Array (DelayedDestination src)
  instEqType    : ∀ {dst src}, (instantaneous dst = some src) → dst.type = src.type

end Class
end Network.Graph


import smt2

lemma fstar_goal_with_unit
(a b q : nat)
(prf_b : 0 < b)
(prf_q : 0 < q)
(p : unit → Prop)
(x : forall (x : unit), p x) : a = a :=
begin
    z3 "fst.log"
end


import data.finset.basic
import data.nat.basic
import init.data.fin.ops
import init.data.option.basic

import .yul_cmd

namespace YulSemantics

open YulCommands
open YulCommands.TermType
open YulCommands.IsInFunc
open YulCommands.IsInFor
open YulCommands.YulTerm

variable τ : Type
variable Γ : FTContext

inductive Mode : IsInFor → IsInFunc → Type
  | NormMode : ∀ {b : IsInFor} {b' : IsInFunc}, Mode b b'
  | BreakMode  : ∀ {b' : IsInFunc}, Mode NestedInFor b'
  | ContinueMode : ∀ {b' : IsInFunc}, Mode NestedInFor b'
  | LeaveMode : ∀ {b : IsInFor}, Mode b InFunc
  | TermMode : ∀ {b : IsInFor} {b' : IsInFunc}, Mode b b'

open Mode

def liftMode :
      ∀ {b : IsInFor} {b' : IsInFunc},
    Mode NotNestedInFor NotInFunc → Mode b b'
| _ _ NormMode := NormMode
| _ _ TermMode := TermMode

def mode_eq : ∀ {b : IsInFor} {b' : IsInFunc}, Mode b b' -> Mode b b' -> Prop
| _ _ NormMode NormMode := true
| _ _ BreakMode BreakMode := true
| _ _ ContinueMode ContinueMode := true
| _ _ LeaveMode LeaveMode := true
| _ _ TermMode TermMode := true
| _ _ BreakMode NormMode := false
| _ _ ContinueMode NormMode := false
| _ _ LeaveMode NormMode := false
| _ _ TermMode NormMode := false
| _ _ NormMode BreakMode := false
| _ _ ContinueMode BreakMode := false
| _ _ LeaveMode BreakMode := false
| _ _ TermMode BreakMode := false
| _ _ NormMode ContinueMode := false
| _ _ BreakMode ContinueMode := false
| _ _ LeaveMode ContinueMode := false
| _ _ TermMode ContinueMode := false
| _ _ NormMode LeaveMode := false
| _ _ BreakMode LeaveMode := false
| _ _ ContinueMode LeaveMode := false
| _ _ TermMode LeaveMode := false
| _ _ NormMode TermMode := false
| _ _ BreakMode TermMode := false
| _ _ ContinueMode TermMode := false
| _ _ LeaveMode TermMode := false

instance (b : IsInFor) (b' : IsInFunc) (a : Mode b b') (b : Mode b b') : decidable (mode_eq a b) :=
  begin
    cases a,
    repeat {
      cases b,
      repeat {
        rw mode_eq,
        apply decidable.is_false,
        intro f,
        exact f,
      },
      rw mode_eq,
      apply decidable.is_true,
      trivial,
    },
  end

def cast_not_in_for_mode : ∀ {b : IsInFor} {b' : IsInFunc}, Mode NotNestedInFor b' → Mode b b' :=
  begin
    intros b b' mode,
    cases mode,
    exact NormMode,
    exact LeaveMode,
    exact TermMode,
  end

def cast_not_in_func_mode : ∀ {b : IsInFor} {b' : IsInFunc}, Mode b NotInFunc → Mode b b' :=
  begin
    intros b b' mode,
    cases mode,
    exact NormMode,
    exact BreakMode,
    exact ContinueMode,
    exact TermMode,
  end

def FDef (n : ℕ) (m : ℕ)  :=
  Σ (arg_ids : vector Identifier n) (ret_args : vector Identifier m) (fin_args : finset Identifier),
    YulTerm Γ
      (BlockList
        (tofinset' arg_ids ∪ tofinset' ret_args)
        (fin_args ∪ tofinset' ret_args)
        NotNestedInFor
        InFunc
      )

/-
   FPrim n m primState is the type of state transformers which
   can fail over primState with arity n and returning m values.
-/

def FPrim (n : ℕ) (m : ℕ) :=
  vector Literal n → τ → option (τ × vector Literal m × Mode NotNestedInFor NotInFunc)

def FImpl (Γ : FTContext) :=
  ∀ i : Identifier, ∀ {n m : ℕ}, Γ i = some (n,m) → FDef Γ n m ⊕ FPrim τ n m

def YulState (Γ : FTContext) (vars : finset Identifier) :=
  VarStore vars × FImpl τ Γ × τ

def merge_scopes : ∀ {vars_outer vars_inner : finset Identifier},
   VarStore vars_outer → VarStore vars_inner → VarStore (vars_inner ∪ vars_outer)
| vars_outer vars_inner vso vsi i i_in_vo_u_vi :=
    dite (i ∈ vars_inner)
      (λ i_in_inner, vsi i i_in_inner)
      (λi_n_in_inner,
        dite (i ∈ vars_outer)
        (λi_in_outer, vso i i_in_outer)
        (λi_n_in_outer,
          let i_n_in_vo_u_vi : ¬  (i ∈ vars_inner ∪ vars_outer) :=
            begin
              intro i_in_vo_u_vi,
              cases finset.mem_union.1 i_in_vo_u_vi with h,
              exact (i_n_in_inner h),
              exact (i_n_in_outer h),
            end
          in absurd i_in_vo_u_vi i_n_in_vo_u_vi
        )
      )

def split_scope : ∀ {vars_inner vars_outer : finset Identifier},
  VarStore vars_outer → VarStore (vars_outer ∪ vars_inner) →
  (VarStore vars_outer × VarStore vars_inner)
| vars_inner vars_outer outer_σ merged_σ' :=
  let outer_σ' : VarStore vars_outer :=
        λ i i_in_o,
          let i_in_o_u_i : i ∈ vars_outer ∪ vars_inner :=
            begin
              apply finset.mem_union.2,
              exact (or.inl i_in_o),
            end
          in merged_σ' i i_in_o_u_i,
      inner_σ' : VarStore vars_inner :=
          λ i i_in_i,
            let i_in_o_u_i : i ∈ vars_outer ∪ vars_inner :=
            begin
              apply finset.mem_union.2,
              exact (or.inr i_in_i),
            end
          in merged_σ' i i_in_o_u_i
  in (outer_σ', inner_σ')

def extend_var_store :
  ∀ {vars : finset Identifier} {n : ℕ} (arg_ids : vector Identifier n) (arg_vals : vector Literal n),
  VarStore vars → VarStore (vars ∪ tofinset' arg_ids)
  | vars 0 _ _ σ i i_in_vars_u_ids :=
    σ i
      begin
        rw tofinset' at i_in_vars_u_ids,
        rw finset.union_empty at i_in_vars_u_ids,
        exact i_in_vars_u_ids,
      end
  | vars (nat.succ n) arg_ids arg_vals σ i i_in_vars_u_ids :=
    dite (i = arg_ids.head)
        (λ_, arg_vals.head)
      (λarg_id_neq_i,
        let i_in_vars_u_ids' : i ∈ vars ∪ tofinset' (arg_ids.tail) :=
              begin
                rw finset.mem_union at i_in_vars_u_ids,
                cases i_in_vars_u_ids,
                apply finset.mem_union.2,
                exact (or.inl i_in_vars_u_ids),
                rw tofinset' at i_in_vars_u_ids,
                rw finset.mem_union at i_in_vars_u_ids,
                cases i_in_vars_u_ids,
                apply finset.mem_union.2,
                exact (or.inr i_in_vars_u_ids),
                exfalso,
                exact arg_id_neq_i (finset.mem_singleton.1 i_in_vars_u_ids),
              end
        in @extend_var_store vars n arg_ids.tail arg_vals.tail σ i i_in_vars_u_ids')

def extract_vars :
  ∀ {n : ℕ} {vars : finset Identifier},
    VarStore vars → ∀ (vec : vector Identifier n),
    tofinset' vec ⊆ vars → vector Literal n
  | 0 _ _ _ _ := vector.nil
  | (nat.succ n) vars σ vec vec_finset_ss_vars :=
      let head_in_vars : vec.head ∈ vars :=
            by {
              exact finset.mem_of_subset
                vec_finset_ss_vars
                (vec_head_in_finset vec),
            },
          tail_ss_vars : tofinset' vec.tail ⊆ vars :=
            by {
              exact finset.subset.trans
                (tl_finset_subset_vec_finset vec)
                vec_finset_ss_vars,
            }
      in vector.cons (σ vec.head head_in_vars)
          (@extract_vars n vars σ vec.tail tail_ss_vars)

def termSize : ∀ {t : TermType}, YulTerm Γ t → ℕ
| _ EmpCBlock := 0
| t blklst@(SeqCBlock _ cstmnt blklst') := 1 + termSize cstmnt
| _ (NestedScope _ _ _ blklst) := 1 + termSize blklst

| _ (CCase _ cblk swtchbody) := 1 + termSize swtchbody
| _ (CDefault cblk) := 0
| _ CNone := 0

| _ (CFunctionCall _ n _ arg_exprs) := 1 + list.sum (list.of_fn (λ i : fin n, 1 + termSize (arg_exprs i)))
| _ (CId _ _) := 0
| _ (CLit _) := 0
| _ (Scope _ _ _ _ cstmnt) := 1 + termSize cstmnt
| _ (Result _) := 0

| _ (CBlock cblk) := 1 + termSize cblk
| _ (CVariableDeclarationAss _ _ cexpr) := 1 + termSize cexpr
| _ (CVariableDeclaration n new_vars) := 0
| _ (CAssignment _ _ _ cexpr) := 1 + termSize cexpr
| _ (CIf cexpr cblk) := 1 + termSize cexpr
| _ (CExpressionStatement cexpr) := 1 + termSize cexpr
| _ (CSwitch cexpr swtchbody) := 1 + termSize cexpr
| _ (CFor _ _ _ init cond body post) := 0
| _ CBreak := 0
| _ CContinue := 0
| _ CLeave := 0
| _ (ForExecInit _ _ _ _ _ _ _ _ eval_init) := 1 + termSize eval_init
| _ (ForCheckCond _ _ _ _ _ _ _ eval_cond) := 1 + termSize eval_cond
| _ (ForExecBody _ _ _ _ _ _ _ _ _ eval_loop) := 1 + termSize eval_loop
| _ (ForExecPost _ _ _ _ _ _ _ _ eval_post) := 1 + termSize eval_post
| _ Skip := 0

def evalMetric :
     (psum
       (Σ' {vars vars'' : finset Identifier} {b : IsInFor} {b' : IsInFunc}
          (blklst : YulTerm Γ (BlockList vars vars'' b b')) (ᾰ : ¬is_empcblock Γ blklst),
          YulState τ Γ vars)
       (psum
          (Σ' {vars : finset Identifier} {b : IsInFor} {b' : IsInFunc} (blk : YulTerm Γ (CBlock vars b b'))
             (ᾰ : ¬is_empblock Γ blk),
             YulState τ Γ vars)
          (psum
             (Σ' {vars : finset Identifier} {n : ℕ} (cexprs : vector (YulTerm Γ (CExpr vars 1)) n)
                (ᾰ : ¬are_args_reduced Γ cexprs),
                YulState τ Γ vars)
             (psum
                (Σ' {vars : finset Identifier} {n : ℕ} (cexpr : YulTerm Γ (CExpr vars n))
                   (ᾰ : ¬is_result Γ cexpr),
                   YulState τ Γ vars)
                (Σ' {vars vars'' : finset Identifier} {b : IsInFor} {b' : IsInFunc}
                   (cstmnt : YulTerm Γ (CStatement vars vars'' b b')) (ᾰ : ¬is_skip Γ cstmnt),
                   YulState τ Γ vars))))) → ℕ
| (psum.inl ⟨_, _, _, _, blklst, _, _⟩) := termSize Γ blklst
| (psum.inr (psum.inl ⟨_, _, _, blk, _, _⟩)) := termSize Γ blk
| (psum.inr (psum.inr (psum.inl ⟨_, n, cexprs, _, _⟩))) := list.sum (list.of_fn (λ i : fin n, 1 + termSize Γ (cexprs.nth i)))
| (psum.inr (psum.inr (psum.inr (psum.inl ⟨_, _, cexpr, _, _⟩)))) := termSize Γ cexpr
| (psum.inr (psum.inr (psum.inr (psum.inr ⟨_, _, _, _, cstmnt, _, _⟩)))) := termSize Γ cstmnt

mutual def evalBlockList, evalCBlock, reduce_last, evalCExpr, evalCStatement

with evalBlockList :
  ∀ {vars vars'' : finset Identifier} {b : IsInFor} {b' : IsInFunc}
      (blklst : YulTerm Γ (BlockList vars vars'' b b')),
    ¬is_empcblock Γ blklst → YulState τ Γ vars →
    option
      Σ vars' : finset Identifier,
        pprod
          (vars ⊆ vars')
          (YulState τ Γ vars' × YulTerm Γ (BlockList vars' vars'' b b') × Mode b b')

| _ _ _ _ blklst@(EmpCBlock) n_is_empcblock _ :=
    let is_empcblock : is_empcblock Γ blklst :=
          begin
            rw is_empcblock,
            trivial,
          end
    in absurd is_empcblock n_is_empcblock
| vars vars'' b b' blklst@(SeqCBlock vars' cstmnt cblklst') n_is_empcblock st :=
  have termSize Γ cstmnt < termSize Γ blklst,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_skip Γ cstmnt)
      (λcstmnt_is_skip,
        pure $
          sigma.mk vars
            ⟨
              finset.subset.refl vars,
              (
                st,
                eq.rec cblklst' (is_skip_imp_vars_eq_vars' Γ cstmnt_is_skip),
                Mode.NormMode
              )
            ⟩
      )
      (λcstmnt_n_is_skip,
        do
        (sigma.mk vars'₁ ⟨p, (st', cstmnt', mode)⟩) ← evalCStatement cstmnt cstmnt_n_is_skip st,
        pure $
          sigma.mk vars'₁
            ⟨
              p,
              (st', SeqCBlock vars' cstmnt' cblklst', mode)
            ⟩
  )

with evalCBlock :
  ∀ {vars : finset Identifier} {b : IsInFor} {b' : IsInFunc}
      (blk : YulTerm Γ (CBlock vars b b')),
    ¬is_empblock Γ blk → YulState τ Γ vars →
    option (YulState τ Γ vars × YulTerm Γ (CBlock vars b b') × Mode b b')
| vars b b' cblk@(NestedScope inner_vars inner_vars'' inner_σ blklst) n_is_empblock st :=
  have termSize Γ blklst < termSize Γ cblk,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  }, do
  let inner_st : YulState τ Γ (inner_vars ∪ vars) :=
    (merge_scopes st.1 inner_σ, st.2),
  let blklst_n_is_empcblock : ¬ is_empcblock Γ blklst :=
    by {
      rw is_empblock at n_is_empblock,
      exact n_is_empblock,
    },
  (sigma.mk all_vars' ⟨p, (inner_st', blklst', mode)⟩) ←
    evalBlockList blklst blklst_n_is_empcblock inner_st,
  let inner_vars' := all_vars' \ vars,
  let p' : vars ⊆ all_vars' := by {exact finset.union_subset_right p},
  let all_vars'_cast_p : all_vars' = vars ∪ (all_vars' \ vars) :=
    by {
      apply eq.symm,
      exact finset.union_sdiff_of_subset p',
    },
  let cast_all_vars' : VarStore (vars ∪ (all_vars' \ vars)) :=
    eq.rec inner_st'.1 all_vars'_cast_p,
  let (outer_σ', inner_σ') := split_scope st.1 cast_all_vars',
  let st' := (outer_σ', inner_st'.2),
  let blklst'_cast_p : all_vars' = all_vars' \ vars ∪ vars :=
    by {
      apply eq.symm,
      exact finset.sdiff_union_of_subset p',
    },
  let cast_blklst' : YulTerm Γ (BlockList (all_vars' \ vars ∪ vars) (inner_vars'' ∪ vars) b b') :=
    eq.rec blklst' blklst'_cast_p,
  pure (st', NestedScope (all_vars' \ vars) inner_vars'' inner_σ' cast_blklst', mode)

with reduce_last :
  ∀ {vars : finset Identifier} {n : ℕ}
    (cexprs : vector (YulTerm Γ (CExpr vars 1)) n),
      ¬(are_args_reduced Γ cexprs) → YulState τ Γ vars →
      option (YulState τ Γ vars × vector (YulTerm Γ (CExpr vars 1)) n × Mode NotNestedInFor NotInFunc)
| vars 0 _ p _ := absurd (@nil_reduced Γ vars) p
| vars (nat.succ n) cexprs n_is_red st :=
  let cexpr' : vector (YulTerm Γ (CExpr vars 1)) n := cexprs.tail in
  have termSize Γ cexprs.head < list.sum (list.of_fn (λ i : fin (nat.succ n), 1 + termSize Γ (cexprs.nth i))),
  by {
    rw list.sum,
    rw (list.foldl_eq_foldr nat.comm_semiring.add_comm
          nat.comm_semiring.add_assoc 0
            (list.of_fn (λ (i : fin n.succ), 1 + termSize Γ (cexprs.nth i)))),
    rw list.of_fn_succ _,
    rw list.foldr,
    rw vector.nth_zero cexprs,
    linarith,
  },
  have list.sum (list.of_fn (λ i : fin n, 1 + termSize Γ (cexprs.tail.nth i)))
          < list.sum (list.of_fn (λ i : fin (nat.succ n), 1 + termSize Γ (cexprs.nth i))),
  by {
    rw list.sum,
    rw list.of_fn_succ _,
    rw (list.foldl_eq_foldr nat.comm_semiring.add_comm
          nat.comm_semiring.add_assoc 0
            ((1 + termSize Γ (cexprs.nth 0)) :: list.of_fn (λ (i : fin n), 1 + termSize Γ (cexprs.nth i.succ)))),
    rw list.foldr,
    apply (ord_lem (termSize Γ (cexprs.nth 0))),
    rw ←(list.foldl_eq_foldr nat.comm_semiring.add_comm
          nat.comm_semiring.add_assoc 0
            (list.of_fn (λ (i : fin n), 1 + termSize Γ (cexprs.nth i.succ)))),
    change list.foldl has_add.add 0 (list.of_fn (λ (i : fin n), 1 + termSize Γ (cexprs.tail.nth i))) ≤
            list.foldl has_add.add 0 (list.of_fn (λ (i : fin n), 1 + termSize Γ (cexprs.nth i.succ))),
    apply nat.le_of_eq,
    apply (@congr_arg (list ℕ) ℕ
            (list.of_fn (λ (i : fin n), 1 + termSize Γ (cexprs.tail.nth i)))
              (list.of_fn (λ (i : fin n), 1 + termSize Γ (cexprs.nth i.succ)))
                (list.foldl has_add.add 0)),
    apply (of_fn_lemma _ _),
    intro i,
    rw vector.nth_tail_succ cexprs i,
  },
  let arg_vec' : vector (YulTerm Γ (CExpr vars 1)) n := cexprs.tail
  in dite (are_args_reduced Γ cexprs.tail)
      (λtl_red, do
        let res : ¬is_result Γ cexprs.head :=
              begin
                rw ←(vector.cons_head_tail cexprs) at n_is_red,
                exact reduced_and_n_tail_reduced_imp_n_lit
                        Γ cexprs.head cexprs.tail n_is_red tl_red,
              end,
        (st', arg', mode) ← evalCExpr cexprs.head res st,
        pure (st', vector.cons arg' arg_vec', mode)
      )
      (λn_tl_red, do
        (st', ⟨args', p⟩, mode) ← @reduce_last vars n cexpr' n_tl_red st,
        pure
            (
              st',
              ⟨
                cexprs.head :: args',
                (by {
                  rw list.length,
                  rw p,
                } : (cexprs.head :: args').length = nat.succ n)
              ⟩,
              mode
            )
      )

with evalCExpr :
  ∀ {vars : finset Identifier} {n : ℕ} (cexpr : YulTerm Γ (CExpr vars n)),
    ¬is_result Γ cexpr → YulState τ Γ vars →
    option (YulState τ Γ vars × YulTerm Γ (CExpr vars n) × Mode NotNestedInFor NotInFunc)
  | _ _ cexpr@(Result _) n_is_res _ :=
    let is_res : is_result Γ cexpr :=
          begin
            rw is_result,
            trivial,
          end
    in absurd is_res n_is_res
  | _ 1 cexpr@(CLit l) _ st :=
    pure
        (
          st,
          Result
            ⟨
              [l],
              by {
                repeat {
                  rw list.length,
                },
              }
            ⟩,
          Mode.NormMode
        )
| _ 1 (CId i i_in_vars) _ st :=
      let l := st.1 i i_in_vars
      in pure (st, CLit l, Mode.NormMode)
| _ _ cexpr@(CFunctionCall f_id n ar_match arg_map) _ st :=
  let arg_vec := (vector.of_fn arg_map)
  in
    have list.sum (list.of_fn (λ i : fin n, 1 + termSize Γ ((vector.of_fn arg_map).nth i))) < termSize Γ cexpr,
      by {
        rw termSize,
        apply (ord_lem 0),
        apply @nat.le.intro _ _ 0,
        rw (nat_add_zero  _),
        apply congr_arg list.sum,
        apply (of_fn_lemma _ _),
        intros i,
        rw vector.nth_of_fn arg_map i,
      },
    dite (are_args_reduced Γ (vector.of_fn arg_map))
      (λ is_red,
          let arg_vals := get_lits Γ (vector.of_fn arg_map) is_red,
              σ := st.1,
              fimpl := st.2.1,
              μ := st.2.2
          in
            let f_impl := fimpl f_id ar_match
            in match f_impl with
                | sum.inl (sigma.mk arg_ids (sigma.mk ret_args (sigma.mk fin_args fbody))) :=
                    let inner_σ : VarStore (tofinset' arg_ids ∪ tofinset' ret_args):=
                          extend_var_store ret_args (default_vals literal_zero)
                            (eq.rec (extend_var_store arg_ids arg_vals empStore)
                              (finset.empty_union $ tofinset' arg_ids))
                    in pure
                        (st, Scope (tofinset' arg_ids) fin_args ret_args inner_σ fbody, Mode.NormMode)
                | sum.inr prim_def := do
                    (μ', res_vec, mode) ← prim_def arg_vals μ,
                    let st' := (σ, fimpl, μ'),
                    pure (st', Result res_vec, mode)
               end
      )
      (λ np, do
        (st', arg_vec', mode) ← reduce_last (vector.of_fn arg_map) np st,
        pure (st', CFunctionCall f_id n ar_match arg_vec'.nth, mode)
      )
| _ _ cexpr@(Scope vars_inner vars_fin ret_ids inner_σ blklst) _ st :=
  have termSize Γ blklst < termSize Γ cexpr,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_empcblock Γ blklst)
      (λ_,  let res_vec := extract_vars inner_σ ret_ids
                            (by {
                              intros i i_in_finset,
                              apply finset.mem_union.2,
                              exact or.inr i_in_finset,
                            })
            in pure (st, Result res_vec, Mode.NormMode)
      )
      (λcstmnt_n_is_empcblock, do
        let inner_st := (inner_σ, st.2),
        (sigma.mk vars_inner' ⟨p, (inner_st', blklst', mode)⟩) ←
          evalBlockList blklst cstmnt_n_is_empcblock inner_st,
        let st' := (st.1, inner_st'.2),
        let inner_σ' := inner_st'.1,
        let inner_σ'_cast_p : vars_inner' = vars_inner' ∪ tofinset' ret_ids :=
          begin
            apply finset.ext_iff.2,
            intro a,
            apply
              (iff_iff_implies_and_implies
                (a ∈ vars_inner')
                (a ∈ vars_inner' ∪ tofinset' ret_ids)).2,
            split,
            intro a_in_vars_inner',
            apply finset.mem_union.2,
            exact or.inl a_in_vars_inner',
            intro a_in_vars_inner'_u_ret_ids,
            cases finset.mem_union.1 a_in_vars_inner'_u_ret_ids,
            exact h,
            exact (finset.union_subset_iff.1 p).2 h,
          end,
        let cast_inner_σ' : VarStore (vars_inner' ∪ tofinset' ret_ids) :=
          eq.rec inner_σ' inner_σ'_cast_p,
        let cast_blklst' :
              YulTerm Γ (BlockList (vars_inner' ∪ tofinset' ret_ids) (vars_fin ∪ tofinset' ret_ids) NotNestedInFor InFunc) :=
            eq.rec blklst' inner_σ'_cast_p,
        pure $
          begin
            cases mode,
            exact (st', Scope vars_inner' vars_fin ret_ids cast_inner_σ' cast_blklst', NormMode),
            exact (st', Scope vars_inner' vars_inner' ret_ids cast_inner_σ' EmpCBlock, NormMode),
            exact (st', Scope vars_inner' vars_fin ret_ids cast_inner_σ' cast_blklst', TermMode),
          end
      )

with evalCStatement :
  ∀ {vars vars'' : finset Identifier} {b : IsInFor} {b' : IsInFunc}
      (cstmnt : YulTerm Γ (CStatement vars vars'' b b')),
    ¬ is_skip Γ cstmnt → YulState τ Γ vars →
    option
      Σ vars' : finset Identifier,
        pprod
          (vars ⊆ vars')
          (YulState τ Γ vars' × YulTerm Γ (CStatement vars' vars'' b b') × Mode b b')
| _ _  _ _ cstmnt@Skip cstmnt_n_is_skip  _ :=
  let cstmnt_is_skip : is_skip Γ cstmnt :=
        begin
          rw is_skip,
          trivial,
        end
  in absurd cstmnt_is_skip cstmnt_n_is_skip
| vars _ _ _ cstmnt@(CBlock blk) _ st :=
  have termSize Γ blk < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_empblock Γ blk)
    (λ_, pure $
          sigma.mk vars
            ⟨finset.subset.refl vars, (st, Skip, Mode.NormMode)⟩
    )
    (λblk_is_empblock, do
      (st', blk', mode) ← evalCBlock blk blk_is_empblock st,
      pure $
        sigma.mk vars
          ⟨finset.subset.refl vars, (st', CBlock blk', mode)⟩
    )
| vars _ _ _ cstmnt@(CVariableDeclarationAss n new_vars cexpr) _ st :=
  have termSize Γ cexpr < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_result Γ cexpr)
    (λcexpr_is_result,
      pure $
        sigma.mk (vars ∪ tofinset new_vars)
        ⟨
          by {
            intros var var_in_vars,
            apply finset.mem_union.2,
            exact or.inl var_in_vars,
          },
          (
            by {
              cases cexpr,
              repeat {
                exfalso,
                rw is_result at cexpr_is_result,
                exact cexpr_is_result,
              },
              rw tofinset,
              exact (extend_var_store (vector.of_fn new_vars) cexpr_ᾰ st.1, st.2),
            },
            Skip,
            Mode.NormMode
          )
        ⟩
    )
    (λcexpr_n_is_result, do
      (st', cexpr', mode) ← evalCExpr cexpr cexpr_n_is_result st,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (st', CVariableDeclarationAss n new_vars cexpr', liftMode mode)
          ⟩
    )
| vars _ _ _ cstmnt@(CVariableDeclaration n new_vars) _ st :=
  pure $
    sigma.mk (vars ∪ tofinset new_vars)
      ⟨
        by {
            intros var var_in_vars,
            apply finset.mem_union.2,
            exact or.inl var_in_vars,
          },
        (
          (extend_var_store (vector.of_fn new_vars) (default_vals literal_zero) st.1, st.2),
          Skip,
          Mode.NormMode
        )
      ⟩
| vars _ _ _ cstmnt@(CAssignment n ids p cexpr) _ st :=
  have termSize Γ cexpr < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_result Γ cexpr)
    (λcexpr_is_result, do
      let vars_eq_vars_u_ids : vars = vars ∪ tofinset' (vector.of_fn ids) :=
            begin
              rw tofinset at p,
              exact finset.left_eq_union_iff_subset.2 p,
            end,
      pure $
        sigma.mk vars
        ⟨
          finset.subset.refl vars,
          (
            by {
              cases cexpr,
              repeat {
                exfalso,
                rw is_result at cexpr_is_result,
                exact cexpr_is_result,
              },
              have σ' := extend_var_store (vector.of_fn ids) cexpr_ᾰ st.1,
              rw ← vars_eq_vars_u_ids at σ',
              exact (σ', st.2),
            },
            Skip,
            Mode.NormMode
          )
        ⟩
    )
    (λcexpr_n_is_result, do
      (st', cexpr', mode) ← evalCExpr cexpr cexpr_n_is_result st,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (st', CAssignment n ids p cexpr', liftMode mode)
          ⟩
    )
| vars _ _ _ cstmnt@(CIf cond body) _ st :=
  have termSize Γ cond < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_result Γ cond)
    (λcond_is_result,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (
              st,
              by {
                cases cond,
                repeat {
                  exfalso,
                  rw is_result at cond_is_result,
                  exact cond_is_result,
                },
                cases cond_ᾰ.head,
                cases val,
                exact Skip,
                exact CBlock body,
              },
              Mode.NormMode
            )
          ⟩
    )
    (λcond_n_is_result, do
      (st', cond', mode) ← evalCExpr cond cond_n_is_result st,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (st', CIf cond' body, liftMode mode)
          ⟩
    )
| vars _ _ _ cstmnt@(CExpressionStatement cexpr) _ st :=
  have termSize Γ cexpr < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_result Γ cexpr)
    (λ_, pure $
          sigma.mk vars
            ⟨
              finset.subset.refl vars,
              (st, Skip, Mode.NormMode)
            ⟩
    )
    (λcexpr_n_is_result, do
      (st', cexpr', mode) ← evalCExpr cexpr cexpr_n_is_result st,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (st', CExpressionStatement cexpr', liftMode mode)
          ⟩
    )
| vars _ _ _ cstmnt@(CSwitch cexpr swtchbody) _ st :=
  have termSize Γ cexpr < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_result Γ cexpr)
    (λcexpr_is_result,
      let lit : Literal := (to_literal Γ cexpr cexpr_is_result).head,
          cblk := getCase Γ lit swtchbody
      in pure $
          sigma.mk vars
            ⟨
              finset.subset.refl vars,
              (st, CBlock cblk, NormMode)
            ⟩
    )
    (λcexpr_n_is_result, do
      (st', cexpr', mode) ← evalCExpr cexpr cexpr_n_is_result st,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (st', CSwitch cexpr' swtchbody, liftMode mode)
          ⟩
    )
| vars _ b b' (CFor inner_vars inner_vars' inner_vars'' init cond loop post) _ st :=
  pure $
    sigma.mk vars
      ⟨
        finset.subset.refl vars,
        let eq_vars : vars = vars ∪ ∅ := eq.symm (finset.union_empty vars),
            init_cast : YulTerm Γ (BlockList (vars ∪ ∅) (vars ∪ inner_vars) NotNestedInFor b') :=
              @eq.rec (finset Identifier) vars
                (λvs, YulTerm Γ (BlockList vs (vars ∪ inner_vars) NotNestedInFor b')) init (vars ∪ ∅)
                  eq_vars,
            cstmnt' : YulTerm Γ (CStatement vars vars b b') :=
              ForExecInit ∅ inner_vars inner_vars' inner_vars'' empStore cond loop post init_cast
        in (st, cstmnt', NormMode)
      ⟩
| vars _ _ b' CBreak _ st :=
  pure $
    sigma.mk vars
      ⟨
          finset.subset.refl vars,
          (st, Skip, BreakMode)
      ⟩
| vars _ _ b' CContinue _ st :=
  pure $
    sigma.mk vars
      ⟨
          finset.subset.refl vars,
          (st, Skip, ContinueMode)
      ⟩
| vars _ b _ CLeave _ st :=
  pure $
    sigma.mk vars
      ⟨
          finset.subset.refl vars,
          (st, Skip, LeaveMode)
      ⟩
| vars _ b b' cstmnt@(ForExecInit curr_inner_vars inner_vars inner_vars' inner_vars'' σ cond loop post eval_init) _ st :=
  have termSize Γ eval_init < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_empcblock Γ eval_init)
    (λeval_init_is_empcblock, do
      let vars_eq_vars' := eq.symm $ is_empcblock_imp_vars_eq_vars' Γ eval_init_is_empcblock,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (
              eq.rec st vars_eq_vars',
              ForCheckCond curr_inner_vars inner_vars' inner_vars'' σ
                (eq.rec cond vars_eq_vars') (eq.rec loop vars_eq_vars') post (eq.rec cond vars_eq_vars'),
              NormMode
            )
          ⟩
    )
    (λeval_init_n_is_empcblock, do
      let inner_st : YulState τ Γ (vars ∪ curr_inner_vars) :=
            (merge_scopes σ st.1, st.2),
      (sigma.mk all_vars' ⟨p, (inner_st', eval_init', mode)⟩)  ← evalBlockList eval_init eval_init_n_is_empcblock inner_st,
      let p' : vars ⊆ all_vars' := by {exact finset.union_subset_left p},
      let all_vars'_cast_p : all_vars' = vars ∪ (all_vars' \ vars) :=
        by {
          apply eq.symm,
          exact finset.union_sdiff_of_subset p',
        },
      let cast_all_vars' : VarStore (vars ∪ (all_vars' \ vars)) :=
            eq.rec inner_st'.1 all_vars'_cast_p,
      let (outer_σ', inner_σ') := split_scope st.1 cast_all_vars',
      let st' := (outer_σ', inner_st'.2),
      let cast_eval_init' : YulTerm Γ (BlockList (vars ∪ (all_vars' \ vars)) (vars ∪ inner_vars) NotNestedInFor b') :=
            eq.rec eval_init' all_vars'_cast_p,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (
              st',
              ForExecInit (all_vars' \ vars) inner_vars inner_vars' inner_vars'' inner_σ' cond loop post cast_eval_init',
              cast_not_in_for_mode mode
            )
          ⟩
    )
| vars _ _ _ cstmnt@(ForCheckCond inner_vars inner_vars' inner_vars'' σ cond body post eval_cond) _ st :=
  have termSize Γ eval_cond < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_result Γ eval_cond)
    (λeval_cond_is_result,
        let lit : Literal := (to_literal Γ eval_cond eval_cond_is_result).head
        in pure $
            sigma.mk vars
              ⟨
                finset.subset.refl vars,
                (
                  st,
                  if lit ≠ literal_zero
                  then ForExecBody inner_vars inner_vars inner_vars' inner_vars'' σ
                        (finset.subset.refl (vars ∪ inner_vars)) cond body post body
                  else Skip,
                  NormMode
                )
              ⟩
    )
    (λeval_cond_n_is_result, do
      let inner_st : YulState τ Γ (vars ∪ inner_vars) :=
             (merge_scopes σ st.1, st.2),
      (inner_st', eval_cond', mode) ← evalCExpr eval_cond eval_cond_n_is_result inner_st,
      let (outer_σ', inner_σ') := split_scope st.1 inner_st'.1,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (
              (outer_σ', inner_st'.2),
              ForCheckCond inner_vars inner_vars' inner_vars'' σ cond body post eval_cond',
              cast_not_in_func_mode (cast_not_in_for_mode mode)
            )
          ⟩
    )
| vars _ b b' cstmnt@(ForExecBody curr_inner_vars inner_vars inner_vars' inner_vars'' σ ss_p cond body post eval_body) _ st :=
  have termSize Γ eval_body < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_empcblock Γ eval_body)
    (λeval_body_is_empcblock, do
      let vars_eq_vars' := eq.symm $ is_empcblock_imp_vars_eq_vars' Γ eval_body_is_empcblock,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (
              eq.rec st vars_eq_vars',
              ForExecPost curr_inner_vars inner_vars inner_vars' inner_vars'' σ
                (eq.rec cond vars_eq_vars') (eq.rec body vars_eq_vars') post (eq.rec post vars_eq_vars'),
              NormMode
            )
          ⟩
    )
    (λeval_body_n_is_empcblock, do
      let inner_st : YulState τ Γ (vars ∪ curr_inner_vars) :=
            (merge_scopes σ st.1, st.2),
      (sigma.mk all_vars' ⟨p, (inner_st', eval_body', mode)⟩) ← evalBlockList eval_body eval_body_n_is_empcblock inner_st,
      let p' : vars ⊆ all_vars' := by {exact finset.union_subset_left p},
      let all_vars'_cast_p : all_vars' = vars ∪ (all_vars' \ vars) :=
        by {
          apply eq.symm,
          exact finset.union_sdiff_of_subset p',
        },
      let cast_all_vars' : VarStore (vars ∪ (all_vars' \ vars)) :=
            eq.rec inner_st'.1 all_vars'_cast_p,
      let (outer_σ', inner_σ') := split_scope st.1 cast_all_vars',
      let st' := (outer_σ', inner_st'.2),
      let cast_eval_body' : YulTerm Γ (BlockList (vars ∪ (all_vars' \ vars)) (vars ∪ inner_vars') NestedInFor b') :=
            eq.rec eval_body' all_vars'_cast_p,
      let ss_p' : vars ∪ inner_vars ⊆ vars ∪ (all_vars' \ vars) :=
            begin
              apply (finset.subset.trans ss_p),
              rw ←all_vars'_cast_p,
              exact p,
            end,
      begin
        apply some,
        apply sigma.mk vars,
        apply (⟨finset.subset.refl vars, _⟩ :
          pprod (vars ⊆ vars) (YulState τ Γ vars × YulTerm Γ (CStatement vars vars b b') × Mode b b')),
        apply (st', _),
        clear _do_match _let_match,
        cases mode,
        exact (
                ForExecBody (all_vars' \ vars) inner_vars inner_vars' inner_vars''
                  inner_σ' ss_p' cond body post cast_eval_body',
                NormMode
              ),
        exact (Skip, NormMode),
        apply (ForCheckCond (all_vars' \ vars) inner_vars' inner_vars'' inner_σ' _ _ _ _, NormMode),
        have cond_framed := frame Γ (vars ∪ (all_vars' \ vars)) cond,
        rw frame_TermType at cond_framed,
        rw finset.right_eq_union_iff_subset.2 ss_p',
        exact cond_framed,
        have body_framed := frame Γ (vars ∪ (all_vars' \ vars)) body,
        rw frame_TermType at body_framed,
        rw finset.right_eq_union_iff_subset.2 ss_p',
        rw finset.left_eq_union_iff_subset.2
            (term_scope_monotonic Γ eval_body'
                      all_vars'
                      (vars ∪ inner_vars') _),
        rw ←all_vars'_cast_p at body_framed,
        rw ←all_vars'_cast_p,
        exact body_framed,
        rw getVariableUpdate,
        exact post,
        have cond_framed := frame Γ (vars ∪ (all_vars' \ vars)) cond,
        rw frame_TermType at cond_framed,
        rw finset.right_eq_union_iff_subset.2 ss_p',
        exact cond_framed,
        exact (
                ForExecBody (all_vars' \ vars) inner_vars inner_vars' inner_vars''
                  inner_σ' ss_p' cond body post cast_eval_body',
                LeaveMode
              ),
        exact (
                ForExecBody (all_vars' \ vars) inner_vars inner_vars' inner_vars''
                  inner_σ' ss_p' cond body post cast_eval_body',
                TermMode
              ),
      end
    )
| vars _ _ b' cstmnt@(ForExecPost curr_inner_vars inner_vars inner_vars' inner_vars'' σ cond body post eval_post) _ st :=
  have termSize Γ eval_post < termSize Γ cstmnt,
  by {
    repeat {
      rw termSize,
    },
    linarith,
  },
  dite (is_empcblock Γ eval_post)
    (λeval_post_is_empcblock, do
      let vars_eq_vars' := eq.symm $ is_empcblock_imp_vars_eq_vars' Γ eval_post_is_empcblock,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (
              eq.rec st vars_eq_vars',
              (begin
                apply (ForCheckCond curr_inner_vars curr_inner_vars curr_inner_vars σ),
                have cond_framed := frame Γ (vars ∪ inner_vars'') cond,
                rw ←vars_eq_vars',
                rw frame_TermType at cond_framed,
                rw (finset.right_eq_union_iff_subset.2 $
                    finset.subset.trans
                              (term_scope_monotonic Γ body
                                (vars ∪ inner_vars)
                                (vars ∪ inner_vars') _)
                              (term_scope_monotonic Γ post
                                (vars ∪ inner_vars')
                                (vars ∪ inner_vars'') _)),
                exact cond_framed,
                repeat {
                  rw getVariableUpdate,
                },
                have body_framed := frame Γ (vars ∪ inner_vars'') body,
                rw ←vars_eq_vars',
                rw frame_TermType at body_framed,
                rw ←(finset.right_eq_union_iff_subset.2 $
                      finset.subset.trans
                        (term_scope_monotonic Γ body
                          (vars ∪ inner_vars)
                          (vars ∪ inner_vars')
                          _
                        )
                        (term_scope_monotonic Γ post
                          (vars ∪ inner_vars')
                          (vars ∪ inner_vars'')
                          _
                        )
                     ) at body_framed,
                rw ←(finset.right_eq_union_iff_subset.2 $
                      (term_scope_monotonic Γ post
                        (vars ∪ inner_vars')
                        (vars ∪ inner_vars'')
                        _
                      )
                    ) at body_framed,
                exact body_framed,
                repeat {
                  rw getVariableUpdate,
                },
                have post_framed := frame Γ (vars ∪ inner_vars'') post,
                rw ←vars_eq_vars',
                rw frame_TermType at post_framed,
                rw ←(finset.right_eq_union_iff_subset.2 $
                      (term_scope_monotonic Γ post
                        (vars ∪ inner_vars')
                        (vars ∪ inner_vars'')
                        _
                      )
                    ) at post_framed,
                rw finset.union_self (vars ∪ inner_vars'') at post_framed,
                exact post_framed,
                repeat {
                  rw getVariableUpdate,
                },
                have cond_eval_framed := frame Γ (vars ∪ inner_vars'') cond,
                rw ←vars_eq_vars',
                rw frame_TermType at cond_eval_framed,
                rw (finset.right_eq_union_iff_subset.2 $
                    finset.subset.trans
                              (term_scope_monotonic Γ body
                                (vars ∪ inner_vars)
                                (vars ∪ inner_vars') _)
                              (term_scope_monotonic Γ post
                                (vars ∪ inner_vars')
                                (vars ∪ inner_vars'') _)),
                exact cond_eval_framed,
                repeat {
                  rw getVariableUpdate,
                },
              end),
              NormMode
            )
          ⟩
    )
    (λeval_post_n_is_empcblock, do
      let inner_st : YulState τ Γ (vars ∪ curr_inner_vars) :=
            (merge_scopes σ st.1, st.2),
      (sigma.mk all_vars' ⟨p, (inner_st', eval_post', mode)⟩) ←
        evalBlockList eval_post eval_post_n_is_empcblock inner_st,
      let p' : vars ⊆ all_vars' := by {exact finset.union_subset_left p},
      let all_vars'_cast_p : all_vars' = vars ∪ (all_vars' \ vars) :=
      by {
        apply eq.symm,
        exact finset.union_sdiff_of_subset p',
      },
      let cast_all_vars' : VarStore (vars ∪ (all_vars' \ vars)) :=
            eq.rec inner_st'.1 all_vars'_cast_p,
      let (outer_σ', inner_σ') := split_scope st.1 cast_all_vars',
      let st' := (outer_σ', inner_st'.2),
      let cast_eval_post' : YulTerm Γ (BlockList (vars ∪ (all_vars' \ vars)) (vars ∪ inner_vars'') NotNestedInFor b') :=
            eq.rec eval_post' all_vars'_cast_p,
      pure $
        sigma.mk vars
          ⟨
            finset.subset.refl vars,
            (
              st',
              ForExecPost (all_vars' \ vars) inner_vars inner_vars' inner_vars'' inner_σ' cond body post cast_eval_post',
              cast_not_in_for_mode mode
            )
          ⟩
    )

using_well_founded {
  rel_tac := λ _ _, `[exact ⟨_, measure_wf (evalMetric τ Γ)⟩],
  dec_tac := `[assumption] }

end YulSemantics


import data.real.basic

theorem exo:
  (exists f: nat -> nat, forall n, f^[2003] (n) = 5 * n)
:=
  sorry


import ReactorModel.Objects
import Mathlib.Data.Finset.Lattice

noncomputable section
open Classical
open ReactorType Updatable Indexable

def Action.schedule (a : Action) (t : Time) (v : Value) : Action :=
  match a.tags.filter (·.time = t) |>.max with
  | ⊥           => a.insert ⟨t, 0⟩ v
  | some ⟨_, m⟩ => a.insert ⟨t, m + 1⟩ v

namespace ReactorType
namespace Updatable

variable [Updatable α]

def apply (rtr : α) : Change → α
  | .prt k i v => update rtr (.prt k) i (fun _ => v)
  | .stv i v   => update rtr .stv     i (fun _ => v)
  | .act i t v => update rtr .act     i (·.schedule t v)
  | .mut ..    => rtr -- Mutations are currently no-ops.

def apply' (rtr : α) (cs : List Change) : α :=
  cs.foldl apply rtr

end Updatable

namespace Indexable

variable [Indexable α]

def dependencies (rtr : α) (rcn : ID) : Set ID :=
  { rcn' | rcn' <[rtr] rcn }

theorem equiv_eq_dependencies {rtr₁ : α} (e : rtr₁ ≈ rtr₂) :
  dependencies rtr₁ = dependencies rtr₂ := by
  ext i j
  exact ⟨.equiv $ .symm e, .equiv e⟩

def scheduledTags (rtr : α) : Set Time.Tag :=
  { g | ∃ i a, (rtr[.act][i] = some a) ∧ (g ∈ a.keys) }

-- TODO?: Make this handle tag names better.
scoped macro "change_cases " change:term : tactic =>
  `(tactic| cases $change:term <;> try cases ‹Change.Normal›; cases ‹Reactor.Component.Valued›)

theorem apply_equiv (rtr : α) (c : Change) : (apply rtr c) ≈ rtr := by
  change_cases c <;> first | rfl | apply LawfulUpdatable.equiv

theorem apply_preserves_unchanged {c : Change} (rtr : α) (h : ¬c.Targets cpt i) :
    (apply rtr c)[cpt][i] = rtr[cpt][i] := by
  change_cases c <;> first | rfl | exact LawfulUpdatable.obj?_preserved (Change.Targets.norm_not h)

variable {rtr : α}

theorem apply_port_change (h : i ∈ rtr[.prt k]) : (apply rtr $ .prt k i v)[.prt k][i] = some v := by
  simp [apply, LawfulUpdatable.obj?_updated]
  exact h

theorem apply_state_change (h : i ∈ rtr[.stv]) : (apply rtr $ .stv i v)[.stv][i] = some v := by
  simp [apply, LawfulUpdatable.obj?_updated]
  exact h

theorem apply_action_change (h : rtr[.act][i] = some a) :
    (apply rtr $ .act i t v)[.act][i] = some (a.schedule t v) := by
  simp [apply, LawfulUpdatable.obj?_updated]
  exact ⟨_, ⟨h, rfl⟩⟩

theorem apply'_equiv (rtr : α) : (cs : List Change) → (apply' rtr cs) ≈ rtr
  | .nil        => .refl
  | .cons hd tl => Equivalent.trans (apply'_equiv (apply rtr hd) tl) (apply_equiv rtr hd)

theorem apply'_preserves_unchanged {cs : List Change} {cpt : Reactor.Component.Valued} {i}
    (h : cs.All₂ (¬·.Targets cpt i)) : (apply' rtr cs)[cpt][i] = rtr[cpt][i] := by
  induction cs generalizing rtr <;> try rfl
  case cons hd tl hi =>
    have ⟨hh, ht⟩ := List.all₂_cons _ _ _ |>.mp h
    exact apply_preserves_unchanged rtr hh ▸ hi ht

theorem apply'_normal_disjoint_comm
    (h : List.Disjoint (cs₁.filter (·.IsNormal)) (cs₂.filter (·.IsNormal))) :
    apply' (apply' rtr cs₁) cs₂ = apply' (apply' rtr cs₂) cs₁ :=
  sorry

end Indexable
end ReactorType


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
  have h1 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h],
  have h2 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h1],
  have h3 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h2],
  have h4 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h3],
  have h5 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h4],
  have h6 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h5],
  have h7 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h6],
  have h8 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h7],
  have h9 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h8],
  have h10 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h9],
  have h11 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h10],
  have h12 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h11],
  have h13 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h12],
  have h14 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h13],
  have h15 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h14],
  have h16 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h15],
  have h17 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h16],
  have h18 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h17],
  have h19 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h18],
  have h20 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h19],
  have h21 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h20],
  have h22 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h21],
  have h23 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h22],
  have h24 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h23],
  have h25 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h24],
  have h26 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h25],
  have h27 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h26],
  have h28 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h27],
  have h29 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h28],
  have h30 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h29],
  have h31 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h30],
  have h32 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h31],
  have h33 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h32],
  have h34 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h33],
  have h35 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h34],
  have h36 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h35],
  have h37 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h36],
  have h38 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h37],
  have h39 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h38],
  have h40 : ∀ n :
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
  have h1 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h],
  have h2 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h1],
  have h3 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h2],
  have h4 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h3],
  have h5 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h4],
  have h6 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h5],
  have h7 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h6],
  have h8 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h7],
  have h9 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h8],
  have h10 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h9],
  have h11 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h10],
  have h12 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h11],
  have h13 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h12],
  have h14 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h13],
  have h15 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h14],
  have h16 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h15],
  have h17 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h16],
  have h18 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h17],
  have h19 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h18],
  have h20 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h19],
  have h21 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h20],
  have h22 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h21],
  have h23 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h22],
  have h24 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h23],
  have h25 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h24],
  have h26 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h25],
  have h27 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h26],
  have h28 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h27],
  have h29 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h28],
  have h30 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h29],
  have h31 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h30],
  have h32 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h31],
  have h33 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h32],
  have h34 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h33],
  have h35 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h34],
  have h36 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h35],
  have h37 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h36],
  have h38 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h37],
  have h39 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by auto [h38],
  have h40 : ∀ n :
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
  let A : ℕ → L.Theory,
  { assume n,
    let A : L.Theory,
    { assume n,
      let A : L.Theory,
      { assume n,
        let A : L.Theory,
        { assume n,
          let A : L.Theory,
          { assume n,
            let A : L.Theory,
            { assume n,
              let A : L.Theory,
              { assume n,
                let A : L.Theory,
                { assume n,
                  let A : L.Theory,
                  { assume n,
                    let A : L.Theory,
                    { assume n,
                      let A : L.Theory,
                      { assume n,
                        let A : L.Theory,
                        { assume n,
                          let A : L.Theory,
                          { assume n,
                            let A : L.Theory,
                            { assume n,
                              let A : L.Theory,
                              { assume n,
                                let A : L.Theory,
                                { assume n,
                                  let A : L.Theory,
                                  { assume n,
                                    let A : L.Theory,
                                    { assume n,
                                      let A : L.Theory,
                                      { assume n,
                                        let A : L.Theory,
                                        { assume n,
                                          let A : L.Theory,
                                          { assume n,
                                            let A : L.Theory,
                                            { assume n,
                                              let A : L.Theory,
                                              { assume n,
                                                let A : L.Theory,
                                                { assume n,
                                                  let A : L.Theory,
                                                  { assume n,
                                                    let A : L.Theory,
                                                    { assume n,
                                                      let A : L.Theory,
                                                      { assume n,
                                                        let A : L.Theory,
                                                        { assume n,
                                                          let A : L.Theory,
                                                          { assume n,
                                                            let A : L.Theory,
                                                            { assume n,
                                                              let A : L.Theory,
                                                              { assume n,
                                                                let A : L.Theory,
                                                                { assume n,
                                                                  let A : L.Theory,
                                                                  { assume n,
                                                                    let A : L.Theory,
                                                                    { assume n,
                                                                      let A : L.Theory,
                                                                      { assume n,
                                                                        let A : L.Theory,
                                                                        { assume n,
                                                                          let A : L.Theory,
                                                                          { assume n,
                                                                            let A : L.Theory,
                                                                            { assume n,
                                                                              let A : L.Theory,
                                                                              { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume n,
                                                                                let A : L.Theory,
                                                                                { assume
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 auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
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 auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [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 auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

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

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
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)-/