import tactic
import .direction
import .list2d
import .boolset2d
import .component2d
import .sokostate

structure boxint :=
(subboxes : bset2d)
(supboxes : bset2d)
(sk_comp : bset2d)

structure boxint.valid (avail : bset2d) (as : boxint) : Prop :=
(sub_sup : as.subboxes ⊆ as.supboxes)
(sup_avail : as.supboxes ⊆ avail)
(sub_disj : as.subboxes.disjoint as.sk_comp)
(sk_comp_avail : as.sk_comp ⊆ avail)
(sk_comp_closed : ∀ xy ∈ as.sk_comp, ∀ d : direction,
  d.shift xy ∈ avail →
  (d.shift xy ∈ as.sk_comp ∨ d.shift xy ∈ as.subboxes))

def boxint.mem (s : sokostate) (as : boxint)
  := s.storekeeper ∈ as.sk_comp ∧
     as.subboxes ⊆ s.boxes ∧ s.boxes ⊆ as.supboxes
instance : has_mem sokostate boxint
:= ⟨boxint.mem⟩
lemma boxint.mem.unfold
  {s : sokostate} {as : boxint}
  : s ∈ as = (s.storekeeper ∈ as.sk_comp ∧
     as.subboxes ⊆ s.boxes ∧ s.boxes ⊆ as.supboxes)
:= rfl
instance boxint.mem.decidable
  (s : sokostate) (as : boxint) : decidable (s ∈ as)
:= begin
  unfold has_mem.mem, unfold boxint.mem, apply_instance,
end

def boxint.disjoint
  (as1 : boxint) (as2 : boxes_only) : Prop
  := ¬ (as1.subboxes ⊆ as2.boxes ∧ as2.boxes ⊆ as1.supboxes)
lemma boxint.disjoint_correct
  (as : boxint) (bs : boxes_only)
  (s : sokostate)
  : as.disjoint bs → s ∈ as → s ∈ bs → false :=
begin
  simp [boxint.mem.unfold, boxes_only.mem.unfold, boxint.disjoint],
  introv Hnsol Hsk Hsub Hsup Hsbs Hbss,
  exact Hnsol (bset2d.subset.trans Hsub Hsbs) (bset2d.subset.trans Hbss Hsup),
end
instance boxint.disjoint.decidable
  (as : boxint) (bs : boxes_only) : decidable (as.disjoint bs)
:= begin
  unfold boxint.disjoint, apply_instance,
end

def boxint.subset (as1 as2 : boxint) : Prop
  := as1.sk_comp ⊆ as2.sk_comp ∧ as2.subboxes ⊆ as1.subboxes
  ∧ as1.supboxes ⊆ as2.supboxes
instance : has_subset boxint := ⟨boxint.subset⟩

lemma boxint.subset_correct (as1 as2 : boxint)
  : as1 ⊆ as2 → ∀ s : sokostate, s ∈ as1 → s ∈ as2 :=
begin
  intros H12 s H1,
  rcases H12 with ⟨H12sk,H12sub,H12sup⟩,
  rcases H1 with ⟨H1sk,H1sub,H1sup⟩,
  split, exact H12sk _ H1sk,
  split, exact bset2d.subset.trans H12sub H1sub,
  exact bset2d.subset.trans H1sup H12sup,
end
instance boxint.subset.decidable
  (as1 as2 : boxint) : decidable (as1 ⊆ as2)
:= begin
  unfold has_subset.subset, unfold boxint.subset, apply_instance,
end

def boxint.subset_g (as1 as2 : boxint) (goal : boxes_only) : Prop
  := as1.sk_comp ⊆ as2.sk_comp ∧ as2.subboxes ⊆ as1.subboxes
  ∧ ( as1.supboxes ⊆ as2.supboxes ∨
    goal.boxes.count ≤ as1.subboxes.count ∧ as1.subboxes ⊆ as2.supboxes )
lemma boxint.subset_g_correct {avail : bset2d} {as1 as2 : boxint} {goal : boxes_only}
: as1.subset_g as2 goal → ∀ s sg : sokostate,
s ∈ as1 → sg ∈ goal → sg.reachable avail s → s ∈ as2
:=
begin
  intros H12 s sg H1 Hg Hr,
  rcases H12 with ⟨H12sk, H12sub, H12sup_cnt⟩,
  rcases H1 with ⟨H1sk,H1sub, H1sup⟩,
  split, exact H12sk _ H1sk,
  split, exact bset2d.subset.trans H12sub H1sub,
  cases H12sup_cnt with H12sup H12sup_cnt,
    exact bset2d.subset.trans H1sup H12sup,
  { cases H12sup_cnt with H_cnt H12sup,
    have : sg.boxes.count = s.boxes.count := sokostate.reachable_keep_box_count Hr,
    have : as1.subboxes.count ≤ s.boxes.count := bset2d.count_le_of_subset _ _ H1sub,
    have : sg.boxes.count ≤ goal.boxes.count := bset2d.count_le_of_subset _ _ Hg.1,
    have : as1.subboxes.count = s.boxes.count, by omega,
    have : s.boxes ⊆ as1.subboxes := bset2d.subset_eq_of_count_eq _ _ H1sub this,
    exact bset2d.subset.trans this H12sup,
  }
end
instance boxint.subset_g.decidable
  (as1 as2 : boxint) (goal : boxes_only) : decidable (as1.subset_g as2 goal)
:= begin
  unfold boxint.subset_g, apply_instance,
end

def boxint.generate (avail : bset2d) (subboxes supboxes : bset2d) (sk : ℕ × ℕ) : boxint
  := {
    subboxes := subboxes,
    supboxes := supboxes,
    sk_comp := component2d (avail \ subboxes) (bset2d.from_index sk),
  }

theorem boxint.generate_valid {avail subboxes supboxes : bset2d} {sk : ℕ × ℕ}
  : subboxes ⊆ supboxes → supboxes ⊆ avail →
  (boxint.generate avail subboxes supboxes sk).valid avail :=
begin
  intros sub_sup sup_avail, split, exact sub_sup, exact sup_avail, {
    intros xy Hsub Hcomp,
    exact bset2d.nmem_of_mem_sdiff (component2d_subset_avail xy Hcomp) Hsub,
  }, {
    intros xy Hcomp,
    exact bset2d.mem_of_mem_sdiff (component2d_subset_avail xy Hcomp),
  }, {
    introv Hcomp Ha2, by_cases C : d.shift xy ∈ subboxes,
    { right, exact C, }, left,
    have Ha2 : d.shift xy ∈ avail \ subboxes
      := bset2d.mem_sdiff_of_mem_nmem Ha2 C,
    exact component2d_closed Hcomp Ha2,
  },
end

def boxint.get_pushes (avail : bset2d) (s : boxint)
  : list (direction × (ℕ × ℕ))
  := do
  box ← s.subboxes.to_indexes,
  d ← direction.luniv,
  if d.shift box ∈ avail ∧ d.shift box ∉ s.subboxes
    ∧ d.opposite.shift box ∈ s.sk_comp
  then return (d, box)
  else list.nil

def boxint.get_appearances (avail : bset2d) (s : boxint)
  : list (direction × (ℕ × ℕ))
  := do
  box ← (avail \ s.supboxes).to_indexes,
  d ← direction.luniv,
  if d.shift box ∈ s.supboxes ∧ d.shift box ∉ s.subboxes
    ∧ d.shift (d.shift box) ∈ s.sk_comp
    ∧ d.shift (d.shift box) ≠ d.shift box
  then return (d.opposite, d.shift box)
  else list.nil

def boxint.get_moves (avail : bset2d) (as : boxint)
  : list (direction × (ℕ × ℕ))
  := boxint.get_pushes avail as ++ boxint.get_appearances avail as

lemma boxint.in_get_moves_iff (avail : bset2d) (s : boxint) (Hv : s.valid avail)
  : ∀ (d : direction) (box : ℕ×ℕ),
  (d,box) ∈ boxint.get_moves avail s ↔ (
    d.opposite.shift box ∈ s.sk_comp ∧
    d.opposite.shift box ≠ box ∧
    d.shift box ∈ avail ∧ d.shift box ∉ s.subboxes ∧
    box ∈ s.supboxes ∧ (d.shift box ∈ s.supboxes → box ∈ s.subboxes)
  ) :=
begin
  intros, unfold boxint.get_moves, rw list.mem_append,
  split, {
    rename box box', rename d d',
    intro H, cases H, {
      unfold boxint.get_pushes at H, simp [-prod.exists] at H,
      rcases H with ⟨box,Hbox,d,Huniv,H⟩, clear Huniv,
      have Hbox := (bset2d.to_indexes_iff _ _).mp Hbox,
      by_cases C : d.shift box ∈ avail ∧ d.shift box ∉ s.subboxes
          ∧ d.opposite.shift box ∈ s.sk_comp, {
        simp [C] at H, rw [H.1, H.2], clear H,
        rcases C with ⟨Ha2, Hnb2, Hsk⟩,
        split, exact Hsk,
        split, { -- disproving border case
          assume Heq, rw Heq at Hsk,
          exact Hv.sub_disj box Hbox Hsk,
        },
        split, exact Ha2, split, exact Hnb2,
        split, exact Hv.sub_sup box Hbox,
        intro, exact Hbox,
      }, { simp [C] at H, exact false.elim H, },
    }, {
      unfold boxint.get_appearances at H, simp [-prod.exists] at H,
      rcases H with ⟨box,Hbox,d,Huniv,H⟩, clear Huniv,
      have Hbox := (bset2d.to_indexes_iff _ box).mp Hbox,
      have Hba: box ∈ avail, from bset2d.mem_of_mem_sdiff Hbox,
      have Hbnsup: box ∉ s.supboxes, from bset2d.nmem_of_mem_sdiff Hbox,
      by_cases C : d.shift box ∈ s.supboxes ∧ d.shift box ∉ s.subboxes
          ∧ d.shift (d.shift box) ∈ s.sk_comp ∧ d.shift (d.shift box) ≠ d.shift box, {
        simp [C] at H, rw [H.1, H.2], clear H,
        rcases C with ⟨Hsup2, Hfree, Hcomp, Hnngen⟩,
        cases direction.opposite_shift d box with Heq Hop_simp, {
          -- border case d.shift box = box
          simp [Heq] at Hnngen, exact false.elim Hnngen,
        }, {
          rw [Hop_simp, direction.opposite_opposite],
          split, exact Hcomp,
          split, exact Hnngen,
          split, exact Hba,
          split, exact mt (Hv.sub_sup box) Hbnsup,
          split, exact Hsup2,
          assume Hbsup, exact false.elim (Hbnsup Hbsup),
        }
      },
      { simp [C] at H, exact false.elim H, }
    }
  }, {
    rintros ⟨Hcomp, Hnngen, Hav, Hfree, Hsup, H⟩,
    by_cases C : box ∈ s.subboxes, { left,
      unfold boxint.get_pushes, simp [-prod.exists], existsi box,
      split, exact (bset2d.to_indexes_iff s.subboxes box).mpr C,
      existsi d, split, exact direction.luniv_complete,
      simp [Hfree, Hcomp, Hav],
    }, { right,
      unfold boxint.get_appearances, simp [-prod.exists], existsi d.shift box,
      split, { show d.shift box ∈ (avail \ s.supboxes).to_indexes,
        apply (bset2d.to_indexes_iff _ _).mpr,
        apply bset2d.mem_sdiff_of_mem_nmem,
        exact Hav, assume H2, exact C (H H2),
      },
      existsi d.opposite,
      split, exact direction.luniv_complete,
      simp [direction.opposite_opposite],
      cases direction.opposite_shift d box with Heq Hop_simp, {
        -- border case, d.shift box = box
        rw Heq at H Hfree, exact false.elim (C (H Hsup)),
      },
      { rw Hop_simp, simp! [Hsup, C, Hcomp, Hnngen], }
    },
  }
end

def boxint.move (avail : bset2d)
  (s : boxint) (d : direction) (box : ℕ×ℕ)
  := boxint.generate avail
     ((s.subboxes.remove box).add (d.shift box))
     ((s.supboxes.remove box).add (d.shift box))
     box

def boxint.next_states (avail : bset2d) (s : boxint) : list boxint
  := list.map (function.uncurry (boxint.move avail s)) (boxint.get_moves avail s)

theorem boxint.next_valid (avail : bset2d) (as1 : boxint)
  : as1.valid avail →
  ∀ as2 : boxint, as2 ∈ as1.next_states avail → as2.valid avail
:=
begin
  introv Hv H, simp [boxint.next_states, -prod.exists] at H,
  rcases H with ⟨⟨d, box⟩, H, Heq⟩,
  simp at Heq, rw ←Heq, clear Heq as2,
  rw (boxint.in_get_moves_iff avail as1 Hv) at H,
  rcases H with ⟨Hcomp, Hnng, Hav, Hnb, Hsp, Hextra⟩,
  apply boxint.generate_valid, {
    apply bset2d.subset_add_same,
    apply bset2d.subset_remove_same,
    exact Hv.sub_sup,
  }, {
    assume xy, assume H,
    cases bset2d.of_mem_add H with H H,
    rw H, exact Hav,
    have := bset2d.mem_of_mem_remove H,
    exact Hv.sup_avail xy this,
  }
end

theorem boxint.next_of_real_move (avail : bset2d) (as1 : boxint) :
  as1.valid avail →
  ∀ (s : sokostate) (d : direction), s ∈ as1 → s.move avail d ∈ as1 ∨
  (∃ as2 : boxint, as2 ∈ as1.next_states avail ∧ s.move avail d ∈ as2)
:=
begin
  intros Hv s d Hin,
  have := Hin,
  rcases this with ⟨Hsk,Hsub,Hsup⟩,
  let box := d.shift s.storekeeper,
  let box2 := d.shift box,
  by_cases C : box ∈ s.boxes ∧ box2 ∈ avail ∧ box2 ∉ s.boxes
    ∧ (box ∈ as1.subboxes ∨ box2 ∉ as1.supboxes), {

    right, -- we move to another abstract state

    existsi as1.move avail d box,
    rcases C with ⟨Hbb, Hb2a, Hb2nb, Has⟩,
    split, { -- in next_states
      simp [boxint.next_states, -prod.exists],
      existsi (d,box), split, {
        apply (boxint.in_get_moves_iff avail as1 Hv d box).mpr,
        have Hngen : box ≠ s.storekeeper, {
          assume Heq, simp [box] at Heq,
          simp only [box,box2,Heq] at Hbb Hb2nb,
          exact false.elim (Hb2nb Hbb),
        },
        have : d.opposite.shift box = s.storekeeper
          := or.resolve_left (direction.opposite_shift d s.storekeeper) Hngen,
        rw this,
        split, exact Hsk,
        split, exact ne_comm.mp Hngen,
        split, exact Hb2a,
        split, exact mt (Hsub box2) Hb2nb,
        split, exact Hsup box Hbb,
        exact or.neg_resolve_right Has,
      }, refl,
    }, { -- emulates real move
      have Hba : box ∈ avail := Hv.sup_avail box (Hsup box Hbb),
      simp [boxint.move, boxint.generate],
      simp [sokostate.move, Hba, Hbb, Hb2a, Hb2nb],
      split, simp, {
        apply component2d_supset, {
          intros xy H,
          rw (bset2d.from_index_iff box xy).1 H, clear H xy,
          apply bset2d.mem_sdiff_of_mem_nmem Hba,
          apply bset2d.nmem_add_of_neq_nmem, {
            intro contra, rw contra at Hbb, exact Hb2nb Hbb,
          }, exact bset2d.nmem_remove,
        },
        exact (bset2d.from_index_iff box box).2 rfl,
      },
      simp, split, {
        apply bset2d.subset_add_same,
        apply bset2d.subset_remove_same,
        exact Hsub,
      },
      apply bset2d.subset_add_same,
      apply bset2d.subset_remove_same,
      exact Hsup,
    }
  },

  left, -- the abstract state remains the same

  simp at C,
  simp [sokostate.move],
  by_cases Cba : box ∈ avail, {
    simp [Cba], by_cases Cbb : box ∈ s.boxes, {
      simp [Cbb], by_cases Cb2a : box2 ∈ avail, {
        simp [Cb2a], by_cases Cb2b : box2 ∈ s.boxes,
        { simp [Cb2b], exact Hin, }, {
          simp [Cb2b],
          have C := C Cbb Cb2a Cb2b,
          cases not_or_distrib.mp C with C1 C2,
          have C2 := not_not.mp C2,
          rw boxint.mem.unfold, split,
            exact or.resolve_right (Hv.sk_comp_closed s.storekeeper Hsk d Cba) C1,
          split, {
            intros xy Hin, apply bset2d.mem_add_of_mem,
            apply bset2d.mem_remove_of_neq_mem,
            { intro contra, rw contra at Hin, exact C1 Hin, },
            { exact Hsub xy Hin },
          }, {
            intros xy Hin, cases bset2d.of_mem_add Hin with Heq Hin,
            { rw Heq, exact C2, },
            { exact Hsup xy (bset2d.mem_of_mem_remove Hin), },
          },
        },
      },
      { simp [Cb2a], exact Hin, },
    },
    { simp [Cbb], split,
      exact or.resolve_right
        (Hv.sk_comp_closed s.storekeeper Hsk d Cba)
        (mt (Hsub box) Cbb),
      exact and.intro Hsub Hsup,
    },
  },
  { simp [Cba], exact Hin, },
end


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v1) ≠ ((((a1).write i1 (v1)).write i3 (v1)).read i1) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v1) ≠ ((((a1).write i2 (v1)).write i3 (v1)).read i2) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v3) ≠ ((((a3).write i3 (v3)).write i2 (v3)).read i3) → False := by
  arr


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 := sorry

end

--OUTPUT 2
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let φ : set L.Formula,
  let φ := F.sentences,

  let φ1 : set L.Formula,
  let φ1 := (λ x : L.Formula, ∃ (a b : x.carrier), a ≠ b),

  let φ2 : set L.Formula,
  let φ2 := (λ x : L.Formula, ∃ (a b c : x.carrier), a ≠ b ∧ b ≠ c ∧ a ≠ c),

  let φ3 : set L.Formula,
  let φ3 := (λ x : L.Formula, ∃ (a b c d : x.carrier), a ≠ b ∧ b ≠ c ∧ c ≠ d ∧ a ≠ c ∧ a ≠ d ∧ b ≠ d),

  let φ4 : set L.Formula,
  let φ4 := (λ x : L.Formula, ∃ (a b c d e : x.carrier), a ≠ b ∧ b ≠ c ∧ c ≠ d ∧ d ≠ e ∧ a ≠ c ∧ a ≠ d ∧ a ≠ e ∧ b ≠ d ∧ b ≠ e ∧ c ≠ e),

  let φ5 : set L.Formula,
  let φ5 := (λ x : L.Formula, ∃ (a b c d e f : x.carrier), a ≠ b ∧ b ≠ c ∧ c ≠ d ∧ d ≠ e ∧ e ≠ f ∧ a ≠ c ∧ a ≠ d ∧ a ≠ e ∧ a ≠ f ∧ b ≠ d ∧ b ≠ e ∧ b ≠ f ∧ c ≠ e ∧ c ≠ f ∧ d ≠ f),

  let φ6 : set L.Formula,
  let φ6 := (λ x : L.Formula, ∃ (a b c d e f g : x.carrier), a ≠ b ∧ b ≠ c ∧ c ≠ d ∧ d ≠ e ∧ e ≠ f ∧ f ≠ g ∧ a ≠ c ∧ a ≠ d ∧ a ≠ e ∧ a ≠ f ∧ a ≠ g ∧ b ≠ d ∧ b ≠ e ∧ b ≠ f ∧ b ≠ g ∧ c ≠ e ∧ c ≠ f ∧ c ≠ g ∧ d ≠ f ∧ d ≠ g ∧ e ≠ g),

  let φ7 : set L.Formula,
  let φ7 := (λ x : L.Formula, ∃ (a b c d e f g h : x.carrier), a ≠ b ∧ b ≠ c ∧ c ≠ d ∧ d ≠ e ∧ e ≠ f ∧ f ≠ g ∧ g ≠ h ∧ a ≠ c ∧ a ≠ d ∧ a ≠ e ∧ a ≠ f ∧ a ≠ g ∧ a ≠ h ∧ b ≠ d ∧ b ≠ e ∧ b ≠ f ∧ b ≠ g ∧ b ≠ h ∧ c ≠ e ∧ c ≠ f ∧ c ≠ g ∧ c ≠ h ∧ d ≠ f ∧ d ≠ g ∧ d ≠ h ∧ e ≠ g ∧ e ≠ h ∧ f ≠ h),

  let φ8 : set L.Formula,
  let φ8 := (λ x : L.Formula, ∃ (a b c d e f g h i : x.carrier), a ≠ b ∧ b ≠ c ∧ c ≠ d ∧ d ≠ e ∧ e ≠ f ∧ f ≠ g ∧ g ≠ h ∧ h ≠ i ∧ a ≠ c ∧ a ≠ d ∧ a ≠ e ∧ a ≠ f ∧ a ≠ g ∧ a ≠ h ∧ a ≠ i ∧ b ≠ d ∧ b ≠ e ∧ b ≠ f ∧ b ≠ g ∧ b ≠ h ∧ b ≠ i ∧ c ≠ e ∧ c ≠ f ∧ c ≠ g ∧ c ≠ h ∧ c ≠ i ∧ d ≠ f ∧ d ≠ g ∧ d ≠ h ∧ d ≠ i ∧ e ≠ g ∧ e ≠ h ∧ e ≠ i ∧ f ≠ h ∧ f ≠ i ∧ g ≠ i),

  let φ9 : set L.Formula,
  let φ9 := (λ x : L.Formula, ∃ (a b c d e f g h i j : x.carrier), a ≠ b ∧ b ≠ c ∧ c ≠ d ∧ d ≠ e ∧ e ≠ f ∧ f ≠ g ∧ g ≠ h ∧ h ≠ i ∧ i ≠ j ∧ a ≠ c ∧ a ≠ d ∧ a ≠ e ∧ a ≠ f ∧ a ≠ g ∧ a ≠ h ∧ a ≠ i ∧ a ≠ j ∧ b ≠ d ∧ b ≠ e ∧ b ≠ f ∧ b ≠ g ∧ b ≠ h ∧ b ≠ i ∧ b ≠ j ∧ c ≠ e ∧ c ≠ f ∧ c ≠ g ∧ c ≠ h ∧ c ≠ i ∧ c ≠ j ∧ d ≠ f ∧ d ≠ g ∧ d ≠ h ∧ d ≠ i ∧ d ≠ j ∧ e ≠ g ∧ e ≠ h ∧ e ≠ i ∧ e ≠ j ∧ f ≠ h ∧ f ≠ i ∧ f ≠ j ∧ g ≠ i ∧ g ≠ j ∧ h ≠ j),

  let φ10 : set L.Formula,
  let φ10 := (λ x : L.Formula, ∃ (a b c d e f g h i j k : x.carrier), a ≠ b ∧ b ≠ c ∧ c ≠ d ∧ d ≠ e ∧ e ≠ f ∧ f ≠ g ∧ g ≠ h ∧ h ≠ i ∧ i ≠ j ∧ j ≠ k ∧ a ≠ c ∧ a ≠ d ∧ a ≠ e ∧ a ≠ f ∧ a ≠ g ∧ a ≠ h ∧ a ≠ i ∧ a ≠ j ∧ a ≠ k ∧ b ≠ d ∧ b ≠ e ∧ b ≠ f ∧ b ≠ g ∧ b ≠ h ∧ b ≠ i ∧ b ≠ j ∧ b ≠ k ∧ c ≠ e ∧ c ≠ f ∧ c ≠ g ∧ c ≠ h ∧ c ≠ i ∧ c ≠ j ∧ c ≠ k ∧ d ≠ f ∧ d ≠ g ∧ d ≠ h ∧ d ≠ i ∧ d ≠ j ∧ d ≠ k ∧ e ≠ g ∧ e ≠ h ∧ e ≠ i ∧ e ≠ j ∧ e ≠ k ∧ f ≠ h ∧ f ≠ i ∧ f ≠ j ∧ f ≠ k ∧ g ≠ i ∧ g ≠ j ∧ g ≠ k ∧ h ≠ j ∧ h ≠ k ∧ i ≠ k),

  let ψ : set L.Formula,
  let ψ := (φ ∪ φ1 ∪ φ2 ∪ φ3 ∪ φ4 ∪ φ5 ∪ φ6 ∪ φ7 ∪ φ8 ∪ φ9 ∪ φ10),

  have h1 : ∀ Γ : set L.Formula, finite Γ → ∃ m : F.Model, Γ ⊆ m.sentences, from by auto [F.sentences_finite_model],

  have h2 : ∀𝔹 Γ : set L.Formula, finite Γ → ∃ m : F.Model, Γ ⊆ m.sentences ∧ finite m.carrier ∧ 𝔹.size ≤ m.size, from by intros 𝔹 Γ hΓ,
  let h3 : ∀𝔹 Γ : set L.Formula,
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h2 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h3 : ∃ (m : F.Model) [mfin : fintype m], 1 ≤ @fintype.card m mfin, from h,
  have h4 : ∃ (m : F.Model) [mfin : fintype m], 2 ≤ @fintype.card m mfin, from h,
  have h5 : ∃ (m : F.Model) [mfin : fintype m], 3 ≤ @fintype.card m mfin, from h,
  have h6 : ∃ (m : F.Model) [mfin : fintype m], 4 ≤ @fintype.card m mfin, from h,
  have h7 : ∃ (m : F.Model) [mfin : fintype m], 5 ≤ @fintype.card m mfin, from h,
  have h8 : ∃ (m : F.Model) [mfin : fintype m], 6 ≤ @fintype.card m mfin, from h,
  have h9 : ∃ (m : F.Model) [mfin : fintype m], 7 ≤ @fintype.card m mfin, from h,
  have h10 : ∃ (m : F.Model) [mfin : fintype m], 8 ≤ @fintype.card m mfin, from h,

  have h11 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from h,
  have h12 : ∃ (m : F.Model) [mfin : fintype m], 1 ≤ @fintype.card m mfin, from h3,
  have h13 : ∃ (m : F.Model) [mfin : fintype m], 2 ≤ @fintype.card m mfin, from h4,
  have h14 : ∃ (m : F.Model) [mfin : fintype m], 3 ≤ @fintype.card m mfin, from h5,
  have h15 : ∃ (m : F.Model) [mfin : fintype m], 4 ≤ @fintype.card m mfin, from h6,
  have h16 : ∃ (m : F.Model) [mfin : fintype m], 5 ≤ @fintype.card m mfin, from h7,
  have h17 : ∃ (m : F.Model) [mfin : fintype m], 6 ≤ @fintype.card m mfin, from h8,
  have h18 : ∃ (m : F.Model) [mfin : fintype m], 7 ≤ @fintype.card m mfin, from h9,
  have h19 : ∃ (m : F.Model) [mfin : fintype m], 8 ≤ @fintype.card m mfin, from h10,
  have h20 : ∃ (m : F.Model) [mfin : fintype m], 9 ≤ @fintype.card m mfin, from h,

  show ∃ (M : F.Model), infinite M, from sorry
end

--OUTPUT 4
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let F' : L.Theory := F.copy,
  let F' := F'.add_finset_of_types 3,
  let F' := F'.add_fun_of_types 2 1,
  let F' := F'.add_binop_of_types (+) (2 : ℕ),
  let F' := F'.add_binop_of_types (<) (2 : ℕ),
  let F' := F'.add_binop_of_types (-) (2 : ℕ),
  let F' := F'.add_binop_of_types (*) (2 : ℕ),
  let F' := F'.add_binop_of_types (^) (2 : ℕ),
  let F' := F'.add_const_of_types 0,

  let F' := F'.add_const_of_types 0,
  let F' := F'.add_const_of_types 1,
  let F' := F'.add_const_of_types 2,
  let F' := F'.add_const_of_types 3,
  let F' := F'.add_const_of_types 4,
  let F' := F'.add_const_of_types 5,
  let F' := F'.add_const_of_types 6,
  let F' := F'.add_const_of_types 7,
  let F' := F'.add_const_of_types 8,
  let F' := F'.add_const_of_types 9,
  let F' := F'.add_const_of_types 10,

  let A : F'.Formula (ℕ) := ∃ ↑x ∃ ↑y ∃ ↑z, ∀ ↑f ∀ ↑g ∀ ↑h ∀ ↑i ∀ ↑j ∀ ↑k ∀ ↑l ∀ ↑m ∀ ↑n ∀ ↑o, x ≠ f ∧ x ≠ g ∧ x ≠ h ∧ x ≠ i ∧ x ≠ j ∧ x ≠ k ∧ x ≠ l ∧ x ≠ m ∧ x ≠ n ∧ x ≠ o ∧ y ≠ f ∧ y ≠ g ∧ y ≠ h ∧ y ≠ i ∧ y ≠ j ∧ y ≠ k ∧ y ≠ l ∧ y ≠ m ∧ y ≠ n ∧ y ≠ o ∧ z ≠ f ∧ z ≠ g ∧ z ≠ h ∧ z ≠ i ∧ z ≠ j ∧ z ≠ k ∧ z ≠ l ∧ z ≠ m ∧ z ≠ n ∧ z ≠ o,

  let add1 := (λ n : ℕ, n + 1),
  let add2 := (λ n : ℕ, n + 2),
  let add3 := (λ n : ℕ, n + 3),
  let add4 := (λ n : ℕ, n + 4),
  let add5 := (λ n : ℕ, n + 5),
  let add6 := (λ n : ℕ, n + 6),
  let add7 := (λ n : ℕ, n + 7),
  let add8 := (λ n : ℕ, n + 8),
  let add9 := (λ n : ℕ, n + 9),

  let sub0 := (λ n : ℕ, 10 - n),
  let sub1 := (λ n : ℕ, 9 - n),
  let sub2 := (λ n : ℕ, 8 - n),
  let sub3 := (λ n : ℕ, 7 - n),
  let sub4 := (λ n : ℕ, 6 - n),
  let sub5 := (λ n : ℕ, 5 - n),
  let sub6 := (λ n : ℕ, 4 - n),
  let sub7 := (λ n : ℕ, 3 - n),
  let sub8 := (λ n : ℕ, 2 - n),
  let sub9 := (λ n : ℕ, 1 - n),

  let A2 := (∀ ↑f ∀ ↑g ∀ ↑h ∀ ↑i ∀ ↑j ∀ ↑k ∀ ↑l ∀ ↑m ∀ ↑n ∀ ↑o, f = 0 ∨ f = 1 ∨ f = 2 ∨ f = 3 ∨ f = 4 ∨ f = 5 ∨ f = 6 ∨ f = 7 ∨ f = 8 ∨ f = 9 → g ≠ f ∧ g ≠ h ∧ g ≠ i ∧ g ≠ j ∧ g ≠ k ∧ g ≠ l ∧ g ≠ m ∧ g ≠ n ∧ g ≠ o ∧ h ≠ g ∧ h ≠ i ∧ h ≠ j ∧ h ≠ k ∧ h ≠ l ∧ h ≠ m ∧ h ≠ n ∧ h ≠ o ∧ i ≠ g ∧ i ≠ h ∧ i ≠ j ∧ i ≠ k ∧ i ≠ l ∧ i ≠ m ∧ i ≠ n ∧ i ≠ o ∧ j ≠ f ∧ j ≠ h ∧ j ≠ i ∧ j ≠ k ∧ j ≠ l ∧ j ≠ m ∧ j ≠ n ∧ j ≠ o ∧ k ≠ f ∧ k ≠ g ∧ k ≠ i ∧ k ≠ j ∧ k ≠ l ∧ k ≠ m ∧ k ≠ n ∧ k ≠ o ∧ l ≠ f ∧ l ≠ g ∧ l ≠ h ∧ l ≠ j ∧ l ≠ k ∧ l ≠ m ∧ l ≠ n ∧ l ≠ o ∧ m ≠ f ∧ m ≠ g ∧ m ≠ h ∧ m ≠ i ∧ m ≠ k ∧ m ≠ l ∧ m ≠ n ∧ m ≠ o ∧ n ≠ f ∧ n ≠ g ∧ n ≠ h ∧ n ≠ i ∧ n ≠ j ∧ n ≠ l ∧ n ≠ m ∧ n ≠ o ∧ o ≠ f ∧ o ≠ g ∧ o ≠ h ∧ o ≠ i ∧ o ≠ j ∧ o ≠ k ∧ o ≠ m ∧ o ≠ n),

  let Γ_0 := ∀ ↑f ∀ ↑g ∀ ↑h ∀ ↑i ∀ ↑j ∀ ↑k ∀ ↑l ∀ ↑m ∀ ↑n ∀ ↑o, f = 0 ∨ f = 1 ∨ f = 2 ∨ f = 3 ∨ f = 4 ∨ f = 5 ∨ f = 6 ∨ f = 7 ∨ f = 8 ∨ f = 9 → g ≠ f ∧ g ≠ h ∧ g ≠ i ∧ g ≠ j ∧ g ≠ k ∧ g ≠ l ∧ g ≠ m ∧ g ≠ n
  ∧ g ≠ o ∧ h ≠ g ∧ h ≠ i ∧ h ≠ j ∧ h ≠ k ∧ h ≠ l ∧ h ≠ m ∧ h ≠ n ∧ h ≠ o ∧ i ≠ g ∧ i ≠ h ∧ i ≠ j ∧ i ≠ k ∧ i ≠ l ∧ i ≠ m ∧ i ≠ n ∧ i ≠ o ∧ j ≠ f ∧ j ≠ h ∧ j ≠ i ∧ j ≠ k ∧ j ≠ l ∧ j ≠ m ∧ j ≠ n ∧ j ≠ o ∧ k ≠ f ∧ k ≠ g ∧ k ≠ i ∧ k ≠ j ∧ k ≠ l ∧ k ≠ m ∧ k ≠ n ∧ k ≠ o ∧ l ≠ f ∧ l ≠ g ∧ l ≠ h ∧ l ≠ j ∧ l ≠ k ∧ l ≠ m ∧ l ≠ n ∧ l ≠ o ∧ m ≠ f ∧ m ≠ g ∧ m ≠ h ∧ m ≠ i ∧ m ≠ k ∧ m ≠ l ∧ m ≠ n ∧ m ≠ o ∧ n ≠ f ∧ n ≠ g ∧ n ≠ h ∧ n ≠ i ∧ n ≠ j ∧ n ≠ l ∧ n ≠ m ∧ n ≠ o ∧
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  -- The negation is used to avoid a contradiction when n = 0
  have h1 : ¬(∀ n : ℕ, n ≤ 0 → ∀ (m : F.Model) [fintype m], n > @fintype.card m fintype), from by auto [lt_irrefl, zero_lt_one, not_zero_nat, zero_le],

  have h2 : ¬(∀ n : ℕ, ∀ (m : F.Model) [fintype m], n > @fintype.card m fintype), from by auto [lt_irrefl, zero_lt_one, not_zero_nat] using [h, h1],

  have h3 : ∃ (M : F.Model), infinite M, from ccw (h2),
  exact h3,
end

--OUTPUT 6
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let A n := ∃ (l : fin n → L.Model.Atom), ∀ (a : fin n → L.Model.Atom), ∃! (m : fin n), l m = a m,
  have h1 : ∃ (M : F.Model) [mfin : fintype M], ∀ (n : ℕ), ¬ A n, from sorry,

  obtain ⟨M, mfin, h2⟩ := h1,

  exact M,
end

--OUTPUT 7
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 Γ :=
    begin
      exact (F ∪ (set.Union ℕ (λ n, {∃ (x₁ x₂ … xₙ : F.Var), ¬ (x₁ = x₂ ∧ … ∧ xₙ₋₁ = xₙ)})))
    end,

  have h1 : ∀ (n : ℕ), F.sat (set.to_finset Γ.val.val.val) (list.repeat F.true n), from by auto,
  have h2 : ∀ (n : ℕ), F.sat (set.to_finset Γ.val.val.val) (↑(Γ.val.val.val.val.val.val) :: list.repeat F.true n), from by auto,

  have h3 : F.T.sat Γ.val.val.val ∨ ¬F.T.sat Γ.val.val.val, from by blast,

  let M := Σ (M : F.Model), F.sat M Γ.val.val.val,
  have h4 : ∃ (M : F.Model), finite M, from by auto [finite.of_fintype, h],
  have h5 : ∃ (M : F.Model), infinite M, from by auto [h4],
  exact h5
end

--OUTPUT 8
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 A1 : ∀ n : ℕ, fintype.card (@fintype.card F.Model (fintype.of_univ) n) = n, from by auto [fintype.card_univ],
  have A2 : ∀ n : ℕ, ∃ ( N : F.Model ) [mN : fintype N], ∀ i : ⋆, i.val < n → N.elems.val i ∈ N.elems.val (fintype.ord_max (n)), from begin
    assume n : ℕ,
    have B1 : ∀ i : ⋆, i.val < n → ∃ (m : F.Model) [mfin : fintype m], fintype.card m = n, from begin
      assume i₀ : ⋆,
      assume h : i₀.val < n,
      have h1 := (hgfp (@fintype.card F.Model (fintype.of_univ) n) (n+1)).val h,
      have h2 := nat.lt_succ_self n,
      have h3 : (n+1) ≤ fintype.card (hgfp (@fintype.card F.Model (fintype.of_univ) n) (n+1)).val, from h1 (λ a b, @nat.le_iff_lt_or_eq.2 b),
      have h4 : (n+1) ≤ (n+1), from by simp,
      have h5 : fintype.card (hgfp (@fintype.card F.Model (fintype.of_univ) n) (n+1)).val = n, from nat.eq_of_le_of_eq_of_le h2 h3 h4,
      have h6 : fintype (hgfp (@fintype.card F.Model (fintype.of_univ) n) (n+1)).val, from by auto [hgfp],
      show ∃ (m : F.Model) [mfin : fintype m], fintype.card m = n, from exists.intro (hgfp (@fintype.card F.Model (fintype.of_univ) n) (n+1)).val (exists.intro h6 h5),
    end,
    have B2 : ∀ i : ⋆, i.val < n → ∃ (m : F.Model), fintype.card m = n, from begin
      assume i₀ : ⋆,
      assume h : i₀.val < n,
      have h1 : ∃ (m : F.Model) [mfin : fintype m], fintype.card m = n, from B1 i₀ h,
      show ∃ (m : F.Model), fintype.card m = n, from exists.elim h1 (λ a b, a),
    end,
    have B3 : ∀ i : ⋆, i.val < n → ∃ (m : F.Model) [mfin : fintype m], fintype.card m = n, from by auto using B2,
    have B4 : ∀ i : ⋆, i.val < n → ∃ (m : F.Model), fintype.card m = n, from by auto using B3,
    have C1 : ∃ (m : F.Model) [mfin : fintype m], fintype.card m = n, from by auto [h, B4],
    have C2 : ∃ (m : F.Model), fintype.card m = n, from exists.elim C1 (λ a b, a),
    have C3 : ∃ (N : F.Model) [mN : fintype N], fintype.card N = n, from C2,
    have C4 : ∃ (N : F.Model) [mN : fintype N], ∀ i : ⋆, i.val < n → N.elems.val i ∈ N.elems.val (fintype.ord_max (n)), from exists.elim C3 (begin
      assume (N : F.Model) [mN : fintype N],
      assume hN : fintype.card N = n,
      have D1 : ∀ i : ⋆, i.val < n → N.elems.val i ∈ N.elems.val (fintype.ord_max (n)), from begin
        assume i₀ : ⋆,
        assume h : i₀.val < n,
        have h1 : ∃ (m : F.Model) [mfin : fintype m], fintype.card m = n, from B1 i₀ h,
        have h2 : fintype.card N = n, from hN,
        have h3 : ∀ i : ⋆, i.val < n → ∃ (m : F.Model), fintype.card m = n, from B4,
        have h4 : ∃ (N : F.Model) [mN : fintype N], fintype.card N = n, from h3 i₀ h,
        have h5 : ∃ (N : F.Model), fintype.card N = n, from exists.elim h4 (λ a b, a),
        have h6 : fintype.card N = fintype.card N, from h2,
        have h7 : fintype.card m = fintype.card N, from eq.trans (h2) (eq.symm (hN)),
        have h8 : ∃ (m : F.Model), fintype.card m = n, from h1,
        have h9 : ∃ (m : F.Model), fintype.card m = n, from h8,
        have h10 : ∃ (m : F.Model), fintype.card m = n, from h1,
        have h11 : ∃ (m : F.Model), fintype.card m = fintype.card N, from eq.trans (h10) (eq.symm h6),
        have h12 : fintype.card m = fintype.card N, from eq.trans (h10) (eq.symm h6),
        have h13 : ∃ (m : F.Model), fintype.card m = fintype.card N, from h11,
        have h14 : fintype.card m = fintype.card N, from eq.trans (h10) (eq.symm h6),
        have h15 : ∃ (m : F.Model), fintype.card m = n, from h1,
        have h16 : fintype.card m = n, from eq.trans (h1) (eq.symm h2),
        have h17 : n = n, from rfl,
        have h18 : ∃ (m : F.Model), fintype.card m = n, from exists.intro (N : F.Model) (exists.intro hN h6),
        have h19 : ∃ (m : F.Model), fintype.card m = fintype.card N, from exists.intro (N : F.Model) (exists.intro hN h6),
        have h20 : fintype.card m = fintype.card N, from h16,
        have h21 : fintype.card m = n, from h16,
        have h22 : (N : F.Model) ∈ N.elems, from by auto [fintype.subtype_val_range],
        have h23 : (N : F.Model) ∈ (N.elems), from h22,
        show N.elems.val i₀ ∈ N.elems.val (fintype.ord_max (n)), from h23,
      end,
      show ∃ (N : F.Model) [mN : fintype N], ∀ i : ⋆, i.val < n → N.elems.val i ∈ N.elems.val (fintype.ord_max (n)), from exists.intro (N : F.Model) (exists.intro mN D1),
    end),
    have C5 : ∃ (N
end --Needs more than 2000 tokens!

--OUTPUT 9
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 Γ := F.add_axiom_of_infinite_models,
  have h1 : F.has_finite_models, from by auto [h],
  have h2 : ∀ (n : ℕ), n < Γ.card → ∃ (m : F.Model), n ≤ m.card, from by auto using [h1],
  have h3 : ∃ (M : F.Model), Γ.card ≤ M.card, from by auto using [compactness.compactness, h2],
  have h4 : ∃ (M : F.Model), infinite M, from by auto [h3],
  show ∃ (M : F.Model), infinite M, from h4,
end

--OUTPUT 10
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), n ≤ fintype.card m, from by auto,

  have h3 : ∀ (n : ℕ), fintype.card ℕ ≥ n, from by linarith [fintype.card_nat],

  have h4 : ∀ (n : ℕ) (m : F.Model) [mfin : fintype m], n ≤ fintype.card m, from by {assume n m mfin, assume h, cases h, exact h},

  have h5 : ∀ (n : ℕ), ∃ (m : F.Model) [mfin : fintype m], fintype.card m ≥ n, from by auto [h1, h3, h4, exists.intro],

  have h6 : ∀ (A : set (L.Formula ℕ)), @fintype.card (set (L.Formula ℕ)) (fintype.fintype_set (L.Formula ℕ)) (F.Theory.SAT_set A) ≥ (fintype.card A), from by auto [fintype.card_SAT_set],

  have h7 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ fintype.card B = fintype.card A, from by auto [fintype.exists_set_of_card_eq, exists.intro],

  have h8 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ F.Theory.SAT_rel B, from by auto [h6, h7],

  have h9 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], fintype.card A < fintype.card (F.Theory.SAT_set A), from by auto,

  have h10 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ F.Theory.SAT_rel B ∧ fintype.card B ≤ fintype.card A, from by auto [h8, h9],

  have h11 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto,

  have h12 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h13 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h14 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h15 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h16 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h17 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h18 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h19 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h20 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h21 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT_set B ∧ fintype.card B < fintype.card A, from by auto [h8, h9],

  have h22 : ∀ (A : set (L.Formula ℕ)) [Afin : fintype A], ∃ (m : F.Model) [mfin : fintype m], ∃ (B : set (L.Formula ℕ)) [Bfin : fintype B], B ⊆ A ∧ m = F.Theory.SAT
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)-/


import for_mathlib.derived.Ext_lemmas
import for_mathlib.Cech.homotopy
import for_mathlib.acyclic
import for_mathlib.exact_seq4
import for_mathlib.cech
import for_mathlib.chain_complex_exact
import for_mathlib.abelian_sheaves.exact
import for_mathlib.Cech.homotopy
import for_mathlib.wide_pullback_iso
import for_mathlib.equivalence_additive

import condensed.adjunctions2
import condensed.projective_resolution
import condensed.extr.equivalence
.

noncomputable theory

universes u

open category_theory category_theory.limits homotopy_category opposite
open function (surjective)

namespace condensed

set_option pp.universes true

-- ANNOYING!
instance presheaf_abelian : abelian (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) :=
category_theory.functor_category_is_abelian.{(u+2) u (u+1)}

-- ANNOYING!
instance ExtrDisc_presheaf_abelian : abelian (ExtrDisc.{u}ᵒᵖ ⥤ Ab.{u+1}) :=
category_theory.functor_category_is_abelian.{(u+2) u (u+1)}

instance ExtrSheaf_abelian' : abelian (Sheaf ExtrDisc.proetale_topology.{u} Ab.{u+1}) :=
category_theory.Sheaf.abelian.{(u+2) u (u+1)}

instance ExtrSheaf_abelian : abelian (ExtrSheaf.{u} Ab.{u+1}) :=
category_theory.Sheaf.abelian.{(u+2) u (u+1)}

def Profinite_to_presheaf_Ab : Profinite.{u} ⥤ Profinite.{u}ᵒᵖ ⥤ Ab.{u+1} :=
yoneda ⋙ (whiskering_right _ _ _).obj (ulift_functor.{u+1} ⋙ AddCommGroup.free)

def Profinite_to_ExtrDisc_presheaf : Profinite.{u} ⥤ ExtrDisc.{u}ᵒᵖ ⥤ Type (u+1) :=
yoneda ⋙ (whiskering_left _ _ _).obj ExtrDisc_to_Profinite.op ⋙
  (whiskering_right _ _ _).obj ulift_functor.{u+1}

def Profinite_to_ExtrDisc_presheaf_Ab : Profinite.{u} ⥤ ExtrDisc.{u}ᵒᵖ ⥤ Ab.{u+1} :=
yoneda ⋙ (whiskering_left _ _ _).obj ExtrDisc_to_Profinite.op ⋙
  (whiskering_right _ _ _).obj (ulift_functor.{u+1} ⋙ AddCommGroup.free)

def unsheafified_free_Cech' (F : arrow Profinite.{u}) :
  chain_complex (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) ℕ :=
simplicial_object.augmented.to_complex $
(((simplicial_object.augmented.whiskering _ _).obj Profinite_to_presheaf_Ab).obj
  F.augmented_cech_nerve)

def unsheafified_free_ExtrDiscr_Cech (F : arrow Profinite.{u}) :
  chain_complex (ExtrDisc.{u}ᵒᵖ ⥤ Ab.{u+1}) ℕ :=
simplicial_object.augmented.to_complex $
(((simplicial_object.augmented.whiskering _ _).obj Profinite_to_ExtrDisc_presheaf_Ab).obj
  F.augmented_cech_nerve)

def free_Cech' (F : arrow Profinite.{u}) :
  chain_complex (Condensed.{u} Ab.{u+1}) ℕ :=
(((simplicial_object.augmented.whiskering _ _).obj
  (Profinite_to_Condensed ⋙ CondensedSet_to_Condensed_Ab)).obj
  F.augmented_cech_nerve).to_complex

def free_ExtrDisc_Cech' (F : arrow Profinite.{u}) :
  chain_complex (ExtrSheaf.{u} Ab.{u+1}) ℕ :=
(((simplicial_object.augmented.whiskering _ _).obj
  (Profinite_to_ExtrDisc_presheaf_Ab ⋙ presheaf_to_Sheaf _ _)).obj
  F.augmented_cech_nerve).to_complex

def free_Cech (F : arrow Profinite.{u}) :
  chain_complex (Condensed.{u} Ab.{u+1}) ℤ :=
(homological_complex.embed $ complex_shape.embedding.nat_down_int_down).obj (free_Cech' F)

instance Condensed_ExtrSheaf_equiv_additive :
  functor.additive (Condensed_ExtrSheaf_equiv Ab.{u+1}).inverse :=
by constructor

def whiskering_Cech_comp_iso
  {C : Type*} [category C] {𝓐 : Type*} [category 𝓐] [abelian 𝓐] {𝓑 : Type*} [category 𝓑] [abelian 𝓑]
  (f : arrow C)
  [∀ (n : ℕ), has_wide_pullback f.right (λ (i : fin (n + 1)), f.left) (λ (i : fin (n + 1)), f.hom)]
  (F : C ⥤ 𝓐) (G : 𝓐 ⥤ 𝓑) (H : C ⥤ 𝓑) (E : F ⋙ G ≅ H) [G.additive] :
  (G.map_homological_complex _).obj ((((simplicial_object.augmented.whiskering _ _).obj F).obj
    f.augmented_cech_nerve).to_complex) ≅
  (((simplicial_object.augmented.whiskering _ _).obj H).obj f.augmented_cech_nerve).to_complex :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| 0 := E.app _
| i+1 := E.app _
end)
begin
  rintros i j (rfl : j + 1 = i),
  dsimp only [functor.map_homological_complex_obj_d,
    unsheafified_free_ExtrDiscr_Cech, free_ExtrDisc_Cech',
    simplicial_object.augmented.to_complex],
  rw [chain_complex.of_d, chain_complex.of_d],
  cases j,
  { dsimp only [whiskering_Cech_comp_iso._match_1],
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      nat_trans.comp_app, whisker_right_app, functor.const_comp_hom_app],
    rw [category.comp_id, category.comp_id, nat_iso.app_hom, ← E.hom.naturality],
    refl },
  {
    dsimp only [whiskering_Cech_comp_iso._match_1],
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.drop_obj,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      simplicial_object.whiskering_obj_obj_map,
      simplicial_object.boundary,
      nat_iso.app_hom],
    simp only [functor.map_sum, functor.map_zsmul, preadditive.comp_sum,
      preadditive.comp_zsmul, preadditive.sum_comp, preadditive.zsmul_comp],
    apply finset.sum_congr rfl, intros _ _,
    erw ← E.hom.naturality,
    refl, },
end

def free_Cech'_iso_ExtrDisc (F : arrow Profinite.{u}) :
  ((Condensed_ExtrSheaf_equiv _).inverse.map_homological_complex _).obj (free_Cech' F) ≅
  free_ExtrDisc_Cech' F :=
let e := ExtrDisc_sheafification_iso in
whiskering_Cech_comp_iso F
  (Profinite_to_Condensed.{u} ⋙ CondensedSet_to_Condensed_Ab.{u})
  ((Condensed_ExtrSheaf_equiv.{u u+2} Ab.{u+1}).inverse)
  (Profinite_to_ExtrDisc_presheaf_Ab.{u} ⋙ presheaf_to_Sheaf.{u+2 u u+1} ExtrDisc.proetale_topology.{u} Ab.{u+1}) $
nat_iso.of_components
(λ S, e.symm.app _)
begin
  intros S T f,
  dsimp only [nat_iso.app_hom],
  erw e.symm.hom.naturality,
  refl,
end

instance presheaf_to_Sheaf_additive :
  (presheaf_to_Sheaf.{u+2 u u+1} ExtrDisc.proetale_topology.{u} Ab.{u+1}).additive :=
category_theory.Sheaf.presheaf_to_Sheaf_additive.{u+2 u u+1}

def acyclic_of_exact.induction_step_ex₂_aux
  {C : Type*} [category C] {𝓐 : Type*} [category 𝓐] [abelian 𝓐] {𝓑 : Type*} [category 𝓑] [abelian 𝓑]
  (f : arrow C)
  [∀ (n : ℕ), has_wide_pullback f.right (λ (i : fin (n + 1)), f.left) (λ (i : fin (n + 1)), f.hom)]
  (F : C ⥤ 𝓐) (G : 𝓐ᵒᵖ ⥤ 𝓑) [G.additive] :
  (G.map_homological_complex _).obj ((((simplicial_object.augmented.whiskering _ _).obj F).obj
    f.augmented_cech_nerve).to_complex).op ≅
  (((cosimplicial_object.augmented.whiskering _ _).obj (F.op ⋙ G)).obj
    f.augmented_cech_nerve.right_op).to_cocomplex :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| 0 := iso.refl _
| i+1 := iso.refl _
end)
begin
  rintros i j (rfl : i + 1 = j),
  dsimp only [functor.map_homological_complex_obj_d,
    unsheafified_free_ExtrDiscr_Cech, free_ExtrDisc_Cech',
    cosimplicial_object.augmented.to_cocomplex,
    simplicial_object.augmented.to_complex, homological_complex.op_d],
  rw [cochain_complex.of_d, chain_complex.of_d],
  cases i,
  { refine (category.id_comp _).trans ((category.comp_id _).trans _).symm,
    dsimp only [simplicial_object.augmented.to_complex_d,
      cosimplicial_object.augmented.to_cocomplex_d,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      cosimplicial_object.augmented.whiskering_obj_2,
      cosimplicial_object.augmented.whiskering_obj,
      nat_trans.comp_app, whisker_right_app,
      functor.const_comp_hom_app, functor.const_comp_inv_app],
    rw [category.comp_id, category.id_comp],
    refl, },
  { refine (category.id_comp _).trans ((category.comp_id _).trans _).symm,
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.drop_obj,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      simplicial_object.whiskering_obj_obj_map,
      simplicial_object.boundary,
      cosimplicial_object.augmented.to_cocomplex_d,
      cosimplicial_object.augmented.drop_obj,
      cosimplicial_object.augmented.whiskering_obj_2,
      cosimplicial_object.augmented.whiskering_obj,
      cosimplicial_object.whiskering_obj_obj_map,
      cosimplicial_object.coboundary],
    simp only [G.map_sum, G.map_zsmul, op_sum, op_zsmul],
    refl, },
end

def free_ExtrDisc_Cech'_iso (F : arrow Profinite.{u}) :
  free_ExtrDisc_Cech' F ≅
  ((presheaf_to_Sheaf _ _).map_homological_complex _).obj (unsheafified_free_ExtrDiscr_Cech F) :=
(whiskering_Cech_comp_iso F _ _ _ $ iso.refl _).symm
/-
homological_complex.hom.iso_of_components
(λ i,
match i with
| 0 := iso.refl _
| i+1 := iso.refl _
end)
begin
  rintros i j (rfl : j + 1 = i),
  dsimp only [functor.map_homological_complex_obj_d,
    unsheafified_free_ExtrDiscr_Cech, free_ExtrDisc_Cech',
    simplicial_object.augmented.to_complex],
  rw [chain_complex.of_d, chain_complex.of_d],
  cases j,
  { refine (category.id_comp _).trans ((category.comp_id _).trans _).symm,
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      nat_trans.comp_app, whisker_right_app, functor.const_comp_hom_app],
    rw [category.comp_id, category.comp_id],
    refl, },
  { refine (category.id_comp _).trans ((category.comp_id _).trans _).symm,
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.drop_obj,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      simplicial_object.whiskering_obj_obj_map,
      simplicial_object.boundary],
    simp only [functor.map_sum, functor.map_zsmul],
    refl, },
end
-/

/-
def free_Cech_iso (F : arrow Profinite.{u}) :
  free_Cech F ≅ (homological_complex.embed $ complex_shape.embedding.nat_down_int_down).obj
  ((presheaf_to_Condensed_Ab.map_homological_complex _).obj
  (unsheafified_free_Cech' F)) :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| int.of_nat 0 := iso.refl _
| int.of_nat (n+1) := iso.refl _
| -[1+i] := iso.refl _
end)
(by admit)
-/

-- SO ANNOYING
instance evaluation_additive (X : ExtrDisc.{u}) :
  functor.additive ((evaluation ExtrDisc.{u}ᵒᵖ Ab.{u+1}).obj (op X)) :=
category_theory.evaluation_additive.{(u+2) u (u+1)} _

def evaluated_free_ExtrDisc_Cech (F : arrow Profinite.{u}) (X : ExtrDisc.{u}) :
  chain_complex Ab.{u+1} ℕ :=
(((simplicial_object.augmented.whiskering _ _).obj
  AddCommGroup.free).obj $
  ((Profinite_to_ExtrDisc_presheaf.flip.obj (op X)).map_arrow.obj F).augmented_cech_nerve).to_complex

.

def yet_another_iso (F : arrow Profinite.{u}) (X : ExtrDisc.{u}) :
  (((evaluation.{u u+1 u+1 u+2} ExtrDisc.{u}ᵒᵖ Ab.{u+1}).obj
  (op X)).map_homological_complex
  (complex_shape.down.{0} ℕ)).obj
  (unsheafified_free_ExtrDiscr_Cech.{u} F) ≅
  evaluated_free_ExtrDisc_Cech F X :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| 0 := iso.refl _
| i+1 := begin apply AddCommGroup.free.map_iso, apply ulift_wide_pullback_iso, end
end)
begin
  rintros (_|i) (_|j) ⟨rfl⟩,
  { dsimp [yet_another_iso._match_1, iso.refl_hom], rw category.comp_id,
    dsimp [evaluated_free_ExtrDisc_Cech, unsheafified_free_ExtrDiscr_Cech],
    rw if_pos (rfl : (1 : ℕ) = 0 + 1), erw category.id_comp,
    rw if_pos (rfl : (1 : ℕ) = 0 + 1), erw category.id_comp,
    apply free_abelian_group.lift.ext,
    rintro ⟨t⟩,
    dsimp [AddCommGroup.free, simplicial_object.augmented.to_complex_d],
    simp only [category.comp_id, comp_apply, free_abelian_group.map_of_apply],
    dsimp at t,
    dsimp [ulift_wide_pullback_iso, ulift_wide_pullback_iso_hom_aux,
      Profinite_to_ExtrDisc_presheaf_Ab], congr' 1,
    have := types_comp_apply
      (wide_pullback.lift (ulift_functor.{u+1 u}.map ((yoneda.{u u+1}.map
        (wide_pullback.base (λ (_x : fin (0 + 0 + 1)), F.hom))).app
        (op.{u+2} X.val))) (λ (q : fin (0 + 0 + 1)), ulift_functor.{u+1 u}.map
        ((yoneda.{u u+1}.map (wide_pullback.π (λ (_x : fin (0 + 0 + 1)),
        F.hom) q)).app (op.{u+2} X.val))) _)
      (wide_pullback.base (λ (i : fin (0 + 0 + 1)),
        (Profinite_to_ExtrDisc_presheaf.{u}.map F.hom).app (op.{u+2} X)))
      (ulift.up t),
    rw ← this, clear this, rw wide_pullback.lift_base, refl },
  { dsimp [yet_another_iso._match_1,
      evaluated_free_ExtrDisc_Cech,
      unsheafified_free_ExtrDiscr_Cech],
    rw [if_pos, if_pos], swap, refl, swap, refl, rw [category.id_comp, category.id_comp],
    dsimp [simplicial_object.augmented.to_complex_d, simplicial_object.boundary],
    simp only [preadditive.sum_comp, preadditive.comp_sum, preadditive.zsmul_comp,
      preadditive.comp_zsmul, category_theory.nat_trans.app_sum,
      category_theory.nat_trans.app_zsmul],
    apply finset.sum_congr rfl, rintros i -, congr' 1,
    dsimp [simplicial_object.δ],

    apply free_abelian_group.lift.ext,
    rintro ⟨t⟩,
    simp only [comp_apply],
    dsimp [AddCommGroup.free, Profinite_to_ExtrDisc_presheaf_Ab], congr' 1,
    dsimp [ulift_wide_pullback_iso, ulift_wide_pullback_iso_hom_aux],

    let f1 := wide_pullback.lift (wide_pullback.base
      (λ (i : fin (j + 1 + 1)), (Profinite_to_ExtrDisc_presheaf.{u}.map F.hom).app (op.{u+2} X)))
      (λ (k : fin (j + 1)), wide_pullback.π
      (λ (i : fin (j + 1 + 1)), (Profinite_to_ExtrDisc_presheaf.{u}.map F.hom).app (op.{u+2} X))
      ((simplex_category.hom.to_order_hom (simplex_category.δ i)) k)) _,

    let f2 := wide_pullback.lift (ulift_functor.{u+1 u}.map ((yoneda.{u u+1}.map
      (wide_pullback.base (λ (_x : fin (j.succ + 0 + 1)), F.hom))).app (op.{u+2} X.val)))
      (λ (q : fin (j.succ + 0 + 1)), ulift_functor.{u+1 u}.map
      ((yoneda.{u u+1}.map (wide_pullback.π
      (λ (_x : fin (j.succ + 0 + 1)), F.hom) q)).app (op.{u+2} X.val))) _,

    let f3 := wide_pullback.lift (ulift_functor.{u+1 u}.map ((yoneda.{u u+1}.map
      (wide_pullback.base (λ (_x : fin (j + 0 + 1)), F.hom))).app (op.{u+2} X.val)))
      (λ (q : fin (j + 0 + 1)), ulift_functor.{u+1 u}.map
      ((yoneda.{u u+1}.map (wide_pullback.π
      (λ (_x : fin (j + 0 + 1)), F.hom) q)).app (op.{u+2} X.val))) _,

    change (f2 ≫ f1) _ = f3 _,

    let f4 := wide_pullback.lift (wide_pullback.base (λ (i : fin (j + 1 + 1)), F.hom))
      (λ (k : fin (j + 1)), wide_pullback.π
      (λ (i : fin (j + 1 + 1)), F.hom) ((simplex_category.hom.to_order_hom
      (simplex_category.δ i)) k)) _,

    suffices : f2 ≫ f1 = ((yoneda'.map f4).app (op X.val) ≫ f3),
    { rw this, refl },

    apply wide_pullback.hom_ext,

    { intros k,
      dsimp [f4,f3,f2,f1],
      simp only [category.assoc, wide_pullback.lift_π, wide_pullback.lift_π_assoc],
      erw [wide_pullback.lift_π],
      erw [← functor.map_comp, ← nat_trans.comp_app, ← functor.map_comp, wide_pullback.lift_π] },

    { dsimp [f4,f3,f2,f1],
      simp only [category.assoc, wide_pullback.lift_base, wide_pullback.lift_base_assoc],
      erw wide_pullback.lift_base,
      erw [← functor.map_comp, ← nat_trans.comp_app, ← functor.map_comp,
        wide_pullback.lift_base] } }
end

lemma free_Cech_exact (F : arrow Profinite.{u}) (hF : function.surjective F.hom) : ∀ (n : ℤ),
  is_zero $ (free_Cech F).homology n :=
begin
  dsimp only [free_Cech],
  rw chain_complex.homology_zero_iff_homology_zero,
  rw chain_complex.homology_zero_iff_map_homology_zero _
    (Condensed_ExtrSheaf_equiv Ab.{u+1}).symm,
  intros i,
  dsimp only [equivalence.symm_functor],
  let E := (_root_.homology_functor _ _ i).map_iso (free_Cech'_iso_ExtrDisc F),
  apply is_zero.of_iso _ E, clear E,
  let E := (_root_.homology_functor _ _ i).map_iso (free_ExtrDisc_Cech'_iso F),
  apply is_zero.of_iso _ E, clear E,
  dsimp only [_root_.homology_functor],
  revert i,
  apply category_theory.Sheaf.map_presheaf_to_Sheaf_homology_zero_of_homology_zero.{(u+2) u (u+1)},
  apply category_theory.homology_zero_of_eval.{(u+2) u (u+1)},
  any_goals { apply_instance },
  intros X, tactic.op_induction',
  intros i,
  let E := (_root_.homology_functor _ _ i).map_iso (yet_another_iso F X),
  apply is_zero.of_iso _ E,
  -- Now we can use the splitting similarly to arrow.conerve_to_cocomplex_homology_is_zero
  -- but we need a dual variant.
  let G := ((Profinite_to_ExtrDisc_presheaf.flip.obj (op X)).map_arrow.obj F),
  haveI : G.split,
  { suffices : function.surjective G.hom,
    { refine ⟨λ i, (this i).some, _⟩,
      ext1 i, exact (this i).some_spec },
    dsimp [G, functor.map_arrow, Profinite_to_ExtrDisc_presheaf, ulift_functor, yoneda],
    rintros ⟨e⟩,
    use ExtrDisc.lift _ hF e,
    ext1,
    dsimp,
    rw ExtrDisc.lift_lifts },
  apply arrow.nerve_to_complex_homology_is_zero AddCommGroup.free G,
  recover,
end

lemma free_Cech_kernel_SES (F : arrow Profinite.{u}) (hF : function.surjective F.hom) : ∀ n,
  short_exact (kernel.ι $ (free_Cech F).d (n+1+1) (n+1)) (delta_to_kernel _ (n+1+1) (n+1) n) :=
begin
  erw ← is_acyclic_iff_short_exact_to_cycles' (free_Cech F), exact free_Cech_exact F hF
end

variable (M : Condensed.{u} Ab.{u+1})

abbreviation HH (i : ℤ) (S : Profinite.{u}) (M : Condensed.{u} Ab.{u+1}) :=
((Ext' i).obj (op $ (CondensedSet_to_Condensed_Ab).obj $ Profinite.to_Condensed S)).obj M

def acyclic_of_exact.IH (n : ℤ) : Prop := ∀ S, ∀ i > 0, i ≤ n → is_zero (HH i S M)

/-- Consider the following commutative diagram
```
     O₀
     ↓
A₁ → B₁ → C₁ → O₁
   ↘ ↓
     B₂
     ↓  ↘
O₃ → B₃ → C₃
```
where `O₀`, `O₁`, and `O₃` are zero objects, and all sequence are exact.

Then `C₁` is also a zero object.
-/
lemma acyclic_of_exact.induction_step_aux {𝓐 : Type*} [category 𝓐] [abelian 𝓐]
  {O₀ O₁ O₃ A₁ B₁ C₁ B₂ B₃ C₃ : 𝓐}
  {α₁ : A₁ ⟶ B₁} {β₁ : B₁ ⟶ C₁} {γ₁ : C₁ ⟶ O₁} (ex₁ : exact_seq 𝓐 [α₁, β₁, γ₁])
  {d₁ : A₁ ⟶ B₂} {d₂ : B₂ ⟶ C₃}                 (exd : exact d₁ d₂)
  {b₀ : O₀ ⟶ B₁} {b₁ : B₁ ⟶ B₂} {b₂ : B₂ ⟶ B₃} (exb : exact_seq 𝓐 [b₀, b₁, b₂])
  {α₃ : O₃ ⟶ B₃} {β₃ : B₃ ⟶ C₃}                 (ex₃ : exact α₃ β₃)
  (hO₀ : is_zero O₀) (hO₁ : is_zero O₁) (hO₃ : is_zero O₃)
  (tr₁ : α₁ ≫ b₁ = d₁) (tr₂ : b₂ ≫ β₃ = d₂) :
  is_zero C₁ :=
begin
  refine (ex₁.drop 1).pair.is_zero_of_eq_zero_eq_zero
    (ex₁.pair.eq_zero_of_epi _) (hO₁.eq_of_tgt _ _),
  haveI : mono b₁ := exb.pair.mono_of_eq_zero (hO₀.eq_of_src _ _),
  haveI : mono β₃ := ex₃.mono_of_eq_zero (hO₃.eq_of_src _ _),
  let l' := abelian.is_limit_of_exact_of_mono _ _ (exb.drop 1).pair,
  let l := is_kernel_comp_mono l' β₃ tr₂.symm,
  obtain rfl :
    α₁ = kernel.lift _ _ exd.w ≫ (is_limit.cone_point_unique_up_to_iso (limit.is_limit _) l).hom,
  { erw [← cancel_mono b₁, category.assoc,
      is_limit.cone_point_unique_up_to_iso_hom_comp _ _ walking_parallel_pair.zero, is_limit.fac,
      fork.of_ι_π_app, tr₁] },
  apply epi_comp
end

lemma acyclic_of_exact.induction_step_ex₁
  (F : arrow Profinite.{u})
  (h : ∀ i, is_zero (((((cosimplicial_object.augmented.whiskering _ _).obj M.val).obj
      F.augmented_cech_nerve.right_op).to_cocomplex).homology i)) :
  let C := (((cosimplicial_object.augmented.whiskering Profiniteᵒᵖ Ab).obj
    ((Profinite_to_Condensed ⋙ CondensedSet_to_Condensed_Ab).op ⋙ preadditive_yoneda.obj M)).obj
    F.augmented_cech_nerve.right_op).to_cocomplex
  in ∀ i, is_zero (C.homology i) :=
begin
  intros C i,
  apply is_zero.of_iso (h i),
  refine (_root_.homology_functor _ _ i).map_iso _,
  refine cosimplicial_object.augmented.cocomplex.map_iso _,
  refine iso.app (functor.map_iso _ (condensed.profinite_free_adj _)) _,
end

lemma acyclic_of_exact.induction_step_ex₂
  (F : arrow Profinite.{u})
  (h : let C := (((cosimplicial_object.augmented.whiskering Profiniteᵒᵖ Ab).obj
    ((Profinite_to_Condensed ⋙ CondensedSet_to_Condensed_Ab).op ⋙ preadditive_yoneda.obj M)).obj
    F.augmented_cech_nerve.right_op).to_cocomplex
    in ∀ i, is_zero (C.homology i)) :
  ∀ i, is_zero ((((preadditive_yoneda.obj M).map_homological_complex _).obj (free_Cech' F).op).homology i) :=
begin
  intro i, apply (h i).of_iso,
  refine (_root_.homology_functor _ _ _).map_iso _,
  apply acyclic_of_exact.induction_step_ex₂_aux,
end

lemma int.of_nat_add_one (i : ℕ) : int.of_nat i + 1 = int.of_nat (i+1) := rfl

lemma complex_shape.embedding.nat_down_int_down.r_int_of_nat (i : ℕ) :
  complex_shape.embedding.nat_down_int_down.r (int.of_nat i) = option.some i := rfl

-- move me
lemma cochain_complex.mono_of_is_zero_homology_0
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐]
  (C : cochain_complex 𝓐 ℕ) (h : is_zero $ C.homology 0) :
  mono (C.d 0 1) :=
begin
  replace h := exact_of_homology_is_zero h,
  rw [C.d_from_eq (show (complex_shape.up ℕ).rel 0 1, by simp), exact_comp_iso] at h,
  refine mono_of_exact_of_eq_zero _ _ _ _ _ h _,
  rw homological_complex.d_to_eq_zero,
  simp only [cochain_complex.prev_nat_zero, complex_shape.up_rel,
      nat.one_ne_zero, not_false_iff],
end

lemma acyclic_of_exact.induction_step_ex₃
  (F : arrow Profinite.{u}) (i : ℤ)
  (h : ∀ i, is_zero ((((preadditive_yoneda.obj M).map_homological_complex _).obj (free_Cech' F).op).homology i)) :
  exact ((preadditive_yoneda.obj M).map $ ((free_Cech F).d (i+1) i).op)
    ((preadditive_yoneda.obj M).map $ ((free_Cech F).d (i+1+1) (i+1)).op) :=
begin
  rcases i with (i|i),
  { delta free_Cech,
    dsimp only [homological_complex.embed, homological_complex.embed.obj],
    rw [int.of_nat_add_one, int.of_nat_add_one],
    erw [complex_shape.embedding.nat_down_int_down.r_int_of_nat],
    erw [complex_shape.embedding.nat_down_int_down.r_int_of_nat],
    erw [complex_shape.embedding.nat_down_int_down.r_int_of_nat],
    dsimp only [homological_complex.embed.d],
    refine exact_of_homology_is_zero ((h (i+1)).of_iso $ _),
    { rw [← functor.map_comp, ← op_comp, homological_complex.d_comp_d, op_zero, functor.map_zero] },
    clear h,
    refine _ ≪≫ (homology_iso _ i (i+1) (i+1+1) _ _).symm,
    swap, { dsimp, refl }, swap, { dsimp, refl },
    refl, },
  { have aux : (preadditive_yoneda.obj M).map ((free_Cech F).d (-[1+ i] + 1) -[1+ i]).op = 0,
    { cases i; erw [op_zero, functor.map_zero], },
    rw [aux], clear aux, apply_with exact_zero_left_of_mono {instances:=ff}, { apply_instance },
    cases i,
    { exact cochain_complex.mono_of_is_zero_homology_0 _ (h 0), },
    { apply mono_of_is_zero_object,
      rw [is_zero_iff_id_eq_zero, ← category_theory.functor.map_id,
        is_zero_iff_id_eq_zero.mp, functor.map_zero],
      refine (is_zero_zero _).op, } },
end

lemma acyclic_of_exact.induction_step_ex₄
  (F : arrow Profinite.{u}) (i : ℤ)
  (h : exact ((preadditive_yoneda.obj M).map $ ((free_Cech F).d (i+1) i).op)
    ((preadditive_yoneda.obj M).map $ ((free_Cech F).d (i+1+1) (i+1)).op)) :
  exact (((Ext' 0).flip.obj M).map $ ((free_Cech F).d (i+1) i).op)
        (((Ext' 0).flip.obj M).map $ ((free_Cech F).d (i+1+1) (i+1)).op) :=
begin
  let e := (bounded_derived_category.Ext'_zero_flip_iso _ M).symm,
  apply preadditive.exact_of_iso_of_exact' _ _ _ _ (e.app _) (e.app _) (e.app _) _ _ h,
  { simp only [nat_iso.app_hom, nat_trans.naturality], },
  { simp only [nat_iso.app_hom, nat_trans.naturality], }
end

lemma acyclic_of_exact.induction_step_ex
  (F : arrow Profinite.{u}) (surj : function.surjective F.hom)
  (h : ∀ i, is_zero (((((cosimplicial_object.augmented.whiskering _ _).obj M.val).obj
      F.augmented_cech_nerve.right_op).to_cocomplex).homology i))
  (i : ℤ) :
  exact (((Ext' 0).flip.obj M).map $ ((free_Cech F).d (i+1) i).op)
        (((Ext' 0).flip.obj M).map $ ((free_Cech F).d (i+1+1) (i+1)).op) :=
begin
  apply acyclic_of_exact.induction_step_ex₄,
  apply acyclic_of_exact.induction_step_ex₃,
  apply acyclic_of_exact.induction_step_ex₂,
  apply acyclic_of_exact.induction_step_ex₁ _ F h,
end

lemma acyclic_of_exact.induction_step
  (h : ∀ (F : arrow Profinite.{u}) (surj : function.surjective F.hom),
    ∀ i, is_zero (((((cosimplicial_object.augmented.whiskering _ _).obj M.val).obj
      F.augmented_cech_nerve.right_op).to_cocomplex).homology i))
  (n : ℤ) (ih : acyclic_of_exact.IH M n) :
  acyclic_of_exact.IH M (n+1) :=
begin
  intros S i h1 h2,
  rw [le_iff_eq_or_lt, or_comm, int.lt_add_one_iff] at h2,
  cases h2 with h2 h2, { exact ih S i h1 h2 },
  subst i,
  let F := arrow.mk S.projective_presentation.f,
  have hF : function.surjective F.hom,
  { rw ← Profinite.epi_iff_surjective, apply projective_presentation.epi },
  let E := λ i, (Ext' i).flip.obj M,
  have ih' : ∀ (i j : ℤ) (h0i : 0 < i) (hin : i ≤ n),
    is_zero ((E i).obj (op ((free_Cech F).X j))),
  { intros i j h0i hin,
    cases j with j j,
    { cases j; exact ih _ _ h0i hin, },
    { apply bounded_derived_category.Ext'_zero_left_is_zero,
      exact (is_zero_zero _).op, } },
  let K := λ i, kernel ((free_Cech F).d (i + 1) i),
  have LES := λ i j, (free_Cech_kernel_SES F hF i).Ext'_five_term_exact_seq M j,
  have H1 : ∀ i > 0, is_zero ((E i).obj (op ((free_Cech F).X 1))),
  { intros i hi,
    apply bounded_derived_category.Ext'_is_zero_of_projective _ _ _ _ hi,
    apply_with Condensed_Ab.free.category_theory.projective {instances:=ff},
    rw [simplicial_object.augmented.drop_obj, arrow.augmented_cech_nerve_left],
    apply projective.of_iso (arrow.cech_nerve_obj_0 F).symm,
    apply projective_presentation.projective, },
  have aux0 : ∀ (i : ℤ) (h0i : 0 < i+1) (H : is_zero ((E i).obj (op $ K 0))),
    is_zero ((E (i+1)).obj (op $ K (-1))),
  { intros i h0i H,
    refine is_zero_of_exact_is_zero_is_zero _ _ ((LES (-1) i).drop 2).pair H (H1 _ h0i), },
  have aux : ∀ (i j : ℤ) (h0i : 0 < i+1) (hi : i+1 ≤ n) (H : is_zero ((E i).obj (op $ K (j+1)))),
    is_zero ((E (i+1)).obj (op $ K j)),
  { intros i j h0i hi H,
    refine is_zero_of_exact_is_zero_is_zero _ _ ((LES j i).drop 2).pair H _,
    refine ih' _ _ h0i hi },
  suffices : ∀ i j, 0 < i → -1 ≤ j → i + j = n → is_zero ((E i).obj (op $ K j)),
  { refine is_zero_of_exact_is_zero_is_zero _ _ (LES (-2) (n+1)).pair _ _; clear LES,
    { apply bounded_derived_category.Ext'_zero_left_is_zero,
      refine (is_zero_of_mono (kernel.ι _) _).op, refine is_zero_zero _, },
    { refine this (n+1) (-1) h1 le_rfl _, rw [← sub_eq_add_neg, add_sub_cancel] } },
  obtain ⟨n, rfl⟩ : ∃ k, k+1 = n := ⟨n-1, sub_add_cancel _ _⟩,
  suffices : is_zero ((E 1).obj (op $ K n)),
  { intro i,
    apply int.induction_on' i 1; clear i,
    { intros j h0i hj hijn, rw [add_comm (1:ℤ), add_left_inj] at hijn, subst j, exact this },
    { intros i hi IH j hi' hj hijn,
      rw le_iff_eq_or_lt at hj, cases hj with hj hj,
      { subst j, apply aux0 _ hi', apply IH; linarith only [hi, hijn] },
      { apply aux _ _ hi' _ (IH _ _ _ _); linarith only [hi, hijn, hj], } },
    { intros i hi IH j hi', exfalso, linarith only [hi, hi'] } },
  clear aux0 aux,
  have aux := λ i, ((LES i (-1)).drop 2).pair.cons (LES i 0),
  have exd := acyclic_of_exact.induction_step_ex M F hF (h F hF) (n+1+1),
  apply acyclic_of_exact.induction_step_aux
    ((LES n 0).drop 1) exd ((aux (n+1)).extract 0 3) (aux (n+1+1)).pair; clear LES aux exd,
  { apply Ext'_is_zero_of_neg, dec_trivial },
  { obtain (rfl|hn) : n = -1 ∨ 1 ≤ n + 1,
    { rw [or_iff_not_imp_right], intro h2, linarith only [h1, h2] },
    { exact H1 _ zero_lt_one },
    { exact ih' _ _ zero_lt_one hn } },
  { apply Ext'_is_zero_of_neg, dec_trivial },
  { conv_rhs { rw [← delta_to_kernel_ι _ _ _ (n+1), op_comp, functor.map_comp] }, refl },
  { conv_rhs { rw [← delta_to_kernel_ι _ _ _ (n+1+1), op_comp, functor.map_comp] }, refl },
end

lemma acyclic_of_exact
  (h : ∀ (F : arrow Profinite.{u}) (surj : function.surjective F.hom),
    ∀ i, is_zero
    (((((cosimplicial_object.augmented.whiskering _ _).obj M.val).obj
      F.augmented_cech_nerve.right_op).to_cocomplex).homology i))
  (S : Profinite.{u}) :
  ∀ i > 0, is_zero (HH i S M)  :=
begin
  intros i hi,
  suffices : acyclic_of_exact.IH M i,
  { apply this S i hi le_rfl, },
  apply int.induction_on' i 0; clear hi i S,
  { intros S i h1 h2, exfalso, exact h2.not_lt h1 },
  { intros k hk, apply acyclic_of_exact.induction_step M h, },
  { rintros k hk aux S i h1 h2, exfalso, linarith only [hk, h1, h2] }
end

end condensed


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (((a3).write i3 ((a3).read i1)).read i1) ≠ ((a3).read i1) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v2) ≠ ((((a1).write i3 (v2)).write i2 (v2)).read i3) → False := by
  arr


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        (v3) ≠ ((((a1).write i2 (v3)).write i3 (v3)).read i2) → False := by
  arr


-- import data.array.lemmas
import tactic
import tactic.squeeze
import data.list.basic
-- import tactic.linarith
-- import data.finmap

universes u v w

structure label (α : Type w) (m : Type u → Type v) (β : Type u) :=
(apply : α → m β)

def goto {α β} {m : Type u → Type v} (f : label α m β) (x : α) := f.apply x

class monad_cont (m : Type u → Type v)
extends monad m :=
(call_cc : Π {α β}, ((label α m β) → m α) → m α)

open monad_cont
class is_lawful_monad_cont (m : Type u → Type v) [monad_cont m]
extends is_lawful_monad m :=
(call_cc_bind_right {α ω γ} (cmd : m α) (next : (label ω m γ) → α → m ω) :
  call_cc (λ f, cmd >>= next f) = cmd >>= λ x, call_cc (λ f, next f x))
(call_cc_bind_left {α} (β) (x : α) (dead : label α m β → β → m α) :
  call_cc (λ f : label α m β, goto f x >>= dead f) = pure x)
(call_cc_dummy {α β} (dummy : m α) :
  call_cc (λ f : label α m β, dummy) = dummy)

export is_lawful_monad_cont

def cont_t (r : Type u) (m : Type u → Type v) (α : Type w) := (α → m r) → m r

namespace cont_t

variables {r : Type u} {m : Type u → Type v} {α β γ ω : Type w}

def run : cont_t r m α → (α → m r) → m r := id

def map (f : m r → m r) (x : cont_t r m α) : cont_t r m α := f ∘ x

lemma run_cont_t_map_cont_t (f : m r → m r) (x : cont_t r m α) :
  run (map f x) = f ∘ run x := rfl

def with_cont_t (f : (β → m r) → α → m r) (x : cont_t r m α) : cont_t r m β :=
λ g, x $ f g

lemma run_with_cont_t (f : (β → m r) → α → m r) (x : cont_t r m α) :
  run (with_cont_t f x) = run x ∘ f := rfl

-- def call_cc (f : (α → cont_t r m β) → cont_t r m α) : cont_t r m α :=
-- λ g, f (λ x h, g x) g

instance : monad (cont_t r m) :=
{ pure := λ α x f, f x,
  bind := λ α β x f g, x $ λ i, f i g }

-- variables [is_lawful_monad m]

instance : is_lawful_monad (cont_t r m) :=
{ id_map := by { intros, refl },
  pure_bind := by { intros, ext, refl },
  bind_assoc := by { intros, ext, refl } }

instance [monad m] : has_monad_lift m (cont_t r m) :=
{ monad_lift := λ a x f, x >>= f }

lemma monad_lift_bind [monad m] [is_lawful_monad m] {α β} (x : m α) (f : α → m β) :
  (monad_lift (x >>= f) : cont_t r m β) = monad_lift x >>= monad_lift ∘ f :=
by { ext, simp only [monad_lift,has_monad_lift.monad_lift,(∘),(>>=),bind_assoc,id.def] }

instance : monad_cont (cont_t r m) :=
{ call_cc := λ α β f g, f ⟨λ x h, g x⟩ g }

instance : is_lawful_monad_cont (cont_t r m) :=
{ call_cc_bind_right := by intros; ext; refl,
  call_cc_bind_left := by intros; ext; refl,
  call_cc_dummy := by intros; ext; refl }

end cont_t

section take_while
open list (hiding take_while)
variables {r : Type u} {m : Type u → Type v} {α β γ ω : Type w}

def take_while' [monad_cont m] {α} (p : α → Prop) [decidable_pred p] (xs : list α) : m (list α) :=
call_cc $ λ leave,
do rs ← mfoldl (λ rs x,
               if p x then pure $ x :: rs
               else goto leave rs.reverse )
               [] xs,
   pure rs.reverse

def take_while (p : α → Prop) [decidable_pred p] (xs : list α) : list α :=
cont_t.run (take_while' p xs) id

meta def assigned : tactic unit :=
do tactic.cleanup

lemma take_while_eq' [monad_cont m] [is_lawful_monad_cont m] {α} (p : α → Prop) [decidable_pred p] (xs : list α) :
  take_while' p xs = (pure $ list.take_while p xs : m (list α)) :=
begin
  suffices : take_while' p xs = (pure $ [].reverse ++ list.take_while p xs : m (list α)),
  { revert this, simp only [imp_self, list.nil_append, list.reverse_nil] },
  dunfold take_while', generalize : list.nil = rs,
  induction xs with x xs generalizing rs,
  { simp only [list.take_while, call_cc_dummy, mfoldl, list.append_nil, pure_bind], },
  { simp [list.take_while, list.mfoldl_cons], split_ifs,
    { simp only [xs_ih,reverse_cons,cons_append,eq_self_iff_true,nil_append,pure_bind,append_assoc] },
    { simp only [bind_assoc, list.append_nil, call_cc_bind_left] } },
end

lemma take_while_eq (p : α → Prop) [decidable_pred p] (xs : list α) :
  take_while p xs = list.take_while p xs :=
by rw [take_while,take_while_eq']; refl

end take_while

section duff -- not the beer

open nat
variables {m : Type u → Type v} {α β γ ω : Type u}
variables (f : α → m α)

section iter
variables [monad m]
def iterate' : ℕ → α → m α
| 0 := pure
| (succ n) := λ x, f x >>= iterate' n
open list

lemma iterate_eq_foldl (n : ℕ) (x : α) :
  iterate' f n x = mfoldl (λ i _, f i)  x (iota n) :=
begin
  induction n with n generalizing x, refl,
  dsimp [iterate',mfoldl,iota],
  congr, ext, apply n_ih,
end

variables [is_lawful_monad m]

lemma iterate_succ' (n : ℕ) (x : α) :
  iterate' f (succ n) x = iterate' f n x >>= f :=
begin
  dsimp [iterate'],
  induction n with n generalizing x;
  simp only [iterate', *, bind_pure, nat.nat_zero_eq_zero, pure_bind],
  rw [← bind_assoc,n_ih],
end

lemma iterate_succ'' (n : ℕ) :
  iterate' f (succ n) = λ x, iterate' f n x >>= f :=
by ext; rw _root_.iterate_succ'

lemma iterate_bind_iterate (x : α) (n k : ℕ) :
  iterate' f k x >>= iterate' f n = iterate' f (k + n) x :=
by induction k generalizing x; simp only [iterate',*,bind_assoc,pure_bind,zero_add,succ_add]

lemma iterate_iterate (n k : ℕ) :
  iterate' (iterate' f n) k = iterate' f (n*k) :=
by induction k; simp only [iterate',*,iterate_bind_iterate,mul_succ,mul_zero,eq_self_iff_true,add_comm]

end iter

variables [monad_cont m]

def iterate_duff' : Π n, (array n (label α m α) → α → m α) → α → m α
| 0 f x := f array.nil x
| (succ n) g x :=
call_cc $ λ goto_n,
do y ← iterate_duff' n (λ a, g $ a.push_back goto_n) x,
   f y

def duff_idx {n} : fin n → fin n
| ⟨i,hi⟩ :=
have h : n - (i + 1) < n,
  from nat.sub_lt_self (lt_of_le_of_lt (nat.zero_le _) hi) (zero_lt_succ _),
⟨n - (i+1), h⟩

def iterate_duff {n} (i : fin n) : α → m α :=
iterate_duff' f n $ λ a,
goto (a.read (duff_idx i))

variables [is_lawful_monad_cont m]

@[simp]
lemma iterate_duff_dummy (n : ℕ) (goto_n : α → m α) (x : α) :
  iterate_duff' f n (λ (a : array n (label α m α)), goto_n) x = goto_n x >>= iterate' f n :=
begin
  induction n generalizing goto_n;
  simp only [iterate_duff',*,_root_.iterate_succ'',call_cc_dummy,bind_assoc],
  simp only [iterate', bind_pure],
end

lemma read_push_back {n} (a : array n α) (x : α) (i : fin $ n+1) :
  (a.push_back x).read (duff_idx i) =
  if h' : i = 0 then x
  else a.read (duff_idx $ i.pred h') :=
by { cases i, dsimp [array.push_back,array.read,duff_idx,d_array.read],
     apply dif_ctx_congr, intros, refl,
     { intros, dsimp [duff_idx,fin.pred], congr' 2,
       cases i_val, contradiction,
       dsimp [pred], rw nat.add_sub_add_right, },
     { rw [nat.add_sub_add_right,nat.sub_eq_iff_eq_add],
       conv { to_lhs, to_lhs, rw ← add_zero n },
       rw add_left_inj, split; intro h;
       try { injection h }; subst i_val; refl,
       apply le_of_lt_succ i_is_lt, } }

lemma coe_pred {n} (i : fin $ succ n) (h : i ≠ 0) :
  ↑(i.pred h) = nat.pred i :=
by cases i; refl

lemma iterate_duff_def {n} (i : fin n) (x : α) :
  iterate_duff f i x = iterate' f i x :=
begin
  dsimp [iterate_duff],
  induction n generalizing i,
  { cases not_lt_zero _ i.is_lt },
  { simp only [iterate_duff', read_push_back], split_ifs,
    { subst i,
      unfold_coes, unfold has_zero.zero,
      simp only [iterate',call_cc_bind_left,bind_assoc, iterate_duff_dummy] },
    { specialize n_ih (i.pred h), simp only [n_ih, call_cc_dummy, coe_pred],
      cases i with i, cases i, contradiction,
      unfold_coes, dsimp [fin.val],
      rw [_root_.iterate_succ'] } }
end

def push_each : Π (l : list α) {n}, array n α → array (n + l.length) α
| [] n a := a
| (x :: xs) n a :=
have n + 1 + xs.length = (n + list.length (x :: xs)),
  by simp only [list.length, add_comm, add_left_comm],
cast (by rw this) $ push_each xs $ a.push_back x

lemma iterate_duff_def_4 (i : fin 4) (x : α) :
  iterate' f i x =
  call_cc (λ goto_n_0 : label α m α,
  call_cc (λ goto_n_1,
  call_cc (λ goto_n_2,
  call_cc (λ goto_n_3,
    let a := push_each [goto_n_3,goto_n_2,goto_n_1,goto_n_0] array.nil in
    goto (a.read (duff_idx i)) x >>=
  λ (y₄ : α), f y₄) >>=
  λ (y₃ : α), f y₃) >>=
  λ (y₂ : α), f y₂) >>=
  λ (y₁ : α), f y₁)
 :=
begin
  rw ← iterate_duff_def,
  dsimp [iterate_duff,iterate_duff'], refl,
end

lemma unroll_iterate_def (n c : ℕ) (h : n > 0) (x : α) :
  iterate' f c x =
  iterate_duff f ⟨c % n, mod_lt c h ⟩ x >>=
  iterate' (iterate' f n) (c / n)  :=
begin
  rw iterate_duff_def, unfold_coes, dsimp [fin.val],
  simp only [iterate_iterate,iterate_bind_iterate,mod_add_div],
end

lemma unroll_iterate_def_4 (c : ℕ) (x : α) :
  iterate' f c x =
  call_cc (λ goto_n_0 : label α m α,
  call_cc (λ goto_n_1,
  call_cc (λ goto_n_2,
  call_cc (λ goto_n_3,
    let a := push_each [goto_n_3,goto_n_2,goto_n_1,goto_n_0] array.nil in
    goto (a.read $ duff_idx (⟨c % 4,mod_lt c dec_trivial⟩)) x >>=
  λ (y₄ : α), f y₄) >>=
  λ (y₃ : α), f y₃) >>=
  λ (y₂ : α), f y₂) >>=
  λ (y₁ : α), f y₁) >>=
  iterate' (λ x,
    f x >>= f >>=
    f >>= f)
    (c / 4) :=
begin
  rw unroll_iterate_def _ 4,
  dsimp [iterate_duff,iterate',iterate_duff'],
  congr, ext, simp only [bind_assoc,bind_pure], apply_instance
end

end duff


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a1 a2 a3 : A I E} :
        ((((a1).write i2 (v3)).write i1 (v3)).read i2) ≠ (v3) → False := by
  arr


/- Enumerable and the Decidable instance may already be in Mathlib -/

class Enumerable (α : Type u) where
  elems    : List α
  complete : ∀ a : α, a ∈ elems

def List.allTrue (p : α → Prop) [(a : α) → Decidable (p a)] : List α → Bool
  | [] => true
  | a :: as => p a && allTrue p as

theorem List.of_allTrue [(a : α) → Decidable (p a)] (hc : allTrue p as) (hin : a ∈ as) : p a := by
  induction as with
  | nil => contradiction
  | cons b bs ih =>
    cases hin with simp [allTrue] at hc
    | head => simp [*]
    | tail _ h => exact ih hc.2 h

theorem List.allTrue_of_forall [(a : α) → Decidable (p a)] (h : ∀ a, p a) : allTrue p as := by
  induction as <;> simp [allTrue, *]

instance [Enumerable α] (p : α → Prop) [(a : α) → Decidable (p a)] : Decidable (∀ a, p a) :=
  have : List.allTrue p Enumerable.elems → (a : α) → p a :=
    fun h a => List.of_allTrue h (Enumerable.complete a)
  decidable_of_decidable_of_iff (Iff.intro this List.allTrue_of_forall)

inductive States | s0 | s1 | s2 | s3 | s4 | s5 | s6 | s7 | s8 | s9 | s10 | s11 | s12 | s13 | s14 | s15 | s16 | s17 | s18 | s19 | s20 | s21 | s22 | s23 | s24 | s25 | s26 | s27 | s28 | s29 | s30 | s31 | s32 | s33 | s34
deriving DecidableEq

/- We can add a `deriving` for `Enumerable` in the future. -/
open States in
instance : Enumerable States where
  elems := [s0, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, s17, s18, s19, s20, s21, s22, s23, s24, s25, s26, s27, s28, s29, s30, s31, s32, s33, s34]
  complete a := by cases a <;> decide

open States
def f : States → States → States
| s0, s0 => s0
| s0, s1 => s0
| s0, s2 => s0
| s0, s3 => s0
| s0, s4 => s0
| s0, s5 => s0
| s0, s6 => s0
| s0, s7 => s0
| s0, s8 => s0
| s0, s9 => s0
| s0, s10 => s0
| s0, s11 => s0
| s0, s12 => s0
| s0, s13 => s0
| s0, s14 => s0
| s0, s15 => s0
| s0, s16 => s0
| s0, s17 => s0
| s0, s18 => s0
| s0, s19 => s0
| s0, s20 => s0
| s0, s21 => s0
| s0, s22 => s0
| s0, s23 => s0
| s0, s24 => s0
| s0, s25 => s0
| s0, s26 => s0
| s0, s27 => s0
| s0, s28 => s0
| s0, s29 => s0
| s0, s30 => s0
| s0, s31 => s0
| s0, s32 => s0
| s0, s33 => s0
| s0, s34 => s0
| s1, s0 => s0
| s1, s1 => s0
| s1, s2 => s0
| s1, s3 => s0
| s1, s4 => s0
| s1, s5 => s0
| s1, s6 => s0
| s1, s7 => s0
| s1, s8 => s0
| s1, s9 => s0
| s1, s10 => s0
| s1, s11 => s0
| s1, s12 => s0
| s1, s13 => s0
| s1, s14 => s0
| s1, s15 => s0
| s1, s16 => s0
| s1, s17 => s0
| s1, s18 => s0
| s1, s19 => s0
| s1, s20 => s0
| s1, s21 => s0
| s1, s22 => s0
| s1, s23 => s0
| s1, s24 => s0
| s1, s25 => s0
| s1, s26 => s0
| s1, s27 => s0
| s1, s28 => s0
| s1, s29 => s0
| s1, s30 => s0
| s1, s31 => s0
| s1, s32 => s0
| s1, s33 => s0
| s1, s34 => s0
| s2, s0 => s0
| s2, s1 => s0
| s2, s2 => s0
| s2, s3 => s0
| s2, s4 => s0
| s2, s5 => s0
| s2, s6 => s0
| s2, s7 => s0
| s2, s8 => s0
| s2, s9 => s0
| s2, s10 => s0
| s2, s11 => s0
| s2, s12 => s0
| s2, s13 => s0
| s2, s14 => s0
| s2, s15 => s0
| s2, s16 => s0
| s2, s17 => s0
| s2, s18 => s0
| s2, s19 => s0
| s2, s20 => s0
| s2, s21 => s0
| s2, s22 => s0
| s2, s23 => s0
| s2, s24 => s0
| s2, s25 => s0
| s2, s26 => s0
| s2, s27 => s0
| s2, s28 => s0
| s2, s29 => s0
| s2, s30 => s0
| s2, s31 => s0
| s2, s32 => s0
| s2, s33 => s0
| s2, s34 => s0
| s3, s0 => s0
| s3, s1 => s0
| s3, s2 => s0
| s3, s3 => s0
| s3, s4 => s0
| s3, s5 => s0
| s3, s6 => s0
| s3, s7 => s0
| s3, s8 => s0
| s3, s9 => s0
| s3, s10 => s0
| s3, s11 => s0
| s3, s12 => s0
| s3, s13 => s0
| s3, s14 => s0
| s3, s15 => s0
| s3, s16 => s0
| s3, s17 => s0
| s3, s18 => s0
| s3, s19 => s0
| s3, s20 => s0
| s3, s21 => s0
| s3, s22 => s0
| s3, s23 => s0
| s3, s24 => s0
| s3, s25 => s0
| s3, s26 => s0
| s3, s27 => s0
| s3, s28 => s0
| s3, s29 => s0
| s3, s30 => s0
| s3, s31 => s0
| s3, s32 => s0
| s3, s33 => s0
| s3, s34 => s0
| s4, s0 => s0
| s4, s1 => s0
| s4, s2 => s0
| s4, s3 => s0
| s4, s4 => s0
| s4, s5 => s0
| s4, s6 => s0
| s4, s7 => s0
| s4, s8 => s0
| s4, s9 => s0
| s4, s10 => s0
| s4, s11 => s0
| s4, s12 => s0
| s4, s13 => s0
| s4, s14 => s0
| s4, s15 => s0
| s4, s16 => s0
| s4, s17 => s0
| s4, s18 => s0
| s4, s19 => s0
| s4, s20 => s0
| s4, s21 => s0
| s4, s22 => s0
| s4, s23 => s0
| s4, s24 => s0
| s4, s25 => s0
| s4, s26 => s0
| s4, s27 => s0
| s4, s28 => s0
| s4, s29 => s0
| s4, s30 => s0
| s4, s31 => s0
| s4, s32 => s0
| s4, s33 => s0
| s4, s34 => s0
| s5, s0 => s0
| s5, s1 => s0
| s5, s2 => s0
| s5, s3 => s0
| s5, s4 => s0
| s5, s5 => s0
| s5, s6 => s0
| s5, s7 => s0
| s5, s8 => s0
| s5, s9 => s0
| s5, s10 => s0
| s5, s11 => s0
| s5, s12 => s0
| s5, s13 => s0
| s5, s14 => s0
| s5, s15 => s0
| s5, s16 => s0
| s5, s17 => s0
| s5, s18 => s0
| s5, s19 => s0
| s5, s20 => s0
| s5, s21 => s0
| s5, s22 => s0
| s5, s23 => s0
| s5, s24 => s0
| s5, s25 => s0
| s5, s26 => s0
| s5, s27 => s0
| s5, s28 => s0
| s5, s29 => s0
| s5, s30 => s0
| s5, s31 => s0
| s5, s32 => s0
| s5, s33 => s0
| s5, s34 => s0
| s6, s0 => s0
| s6, s1 => s0
| s6, s2 => s0
| s6, s3 => s0
| s6, s4 => s0
| s6, s5 => s0
| s6, s6 => s0
| s6, s7 => s0
| s6, s8 => s0
| s6, s9 => s0
| s6, s10 => s0
| s6, s11 => s0
| s6, s12 => s0
| s6, s13 => s0
| s6, s14 => s0
| s6, s15 => s0
| s6, s16 => s0
| s6, s17 => s0
| s6, s18 => s0
| s6, s19 => s0
| s6, s20 => s0
| s6, s21 => s0
| s6, s22 => s0
| s6, s23 => s0
| s6, s24 => s0
| s6, s25 => s0
| s6, s26 => s0
| s6, s27 => s0
| s6, s28 => s0
| s6, s29 => s0
| s6, s30 => s0
| s6, s31 => s0
| s6, s32 => s0
| s6, s33 => s0
| s6, s34 => s0
| s7, s0 => s0
| s7, s1 => s0
| s7, s2 => s0
| s7, s3 => s0
| s7, s4 => s0
| s7, s5 => s0
| s7, s6 => s0
| s7, s7 => s0
| s7, s8 => s0
| s7, s9 => s0
| s7, s10 => s0
| s7, s11 => s0
| s7, s12 => s0
| s7, s13 => s0
| s7, s14 => s0
| s7, s15 => s0
| s7, s16 => s0
| s7, s17 => s0
| s7, s18 => s0
| s7, s19 => s0
| s7, s20 => s0
| s7, s21 => s0
| s7, s22 => s0
| s7, s23 => s0
| s7, s24 => s0
| s7, s25 => s0
| s7, s26 => s0
| s7, s27 => s0
| s7, s28 => s0
| s7, s29 => s0
| s7, s30 => s0
| s7, s31 => s0
| s7, s32 => s0
| s7, s33 => s0
| s7, s34 => s0
| s8, s0 => s0
| s8, s1 => s0
| s8, s2 => s0
| s8, s3 => s0
| s8, s4 => s0
| s8, s5 => s0
| s8, s6 => s0
| s8, s7 => s0
| s8, s8 => s0
| s8, s9 => s0
| s8, s10 => s0
| s8, s11 => s0
| s8, s12 => s0
| s8, s13 => s0
| s8, s14 => s0
| s8, s15 => s0
| s8, s16 => s0
| s8, s17 => s0
| s8, s18 => s0
| s8, s19 => s0
| s8, s20 => s0
| s8, s21 => s0
| s8, s22 => s0
| s8, s23 => s0
| s8, s24 => s0
| s8, s25 => s0
| s8, s26 => s0
| s8, s27 => s0
| s8, s28 => s0
| s8, s29 => s0
| s8, s30 => s0
| s8, s31 => s0
| s8, s32 => s0
| s8, s33 => s0
| s8, s34 => s0
| s9, s0 => s0
| s9, s1 => s0
| s9, s2 => s0
| s9, s3 => s0
| s9, s4 => s0
| s9, s5 => s0
| s9, s6 => s0
| s9, s7 => s0
| s9, s8 => s0
| s9, s9 => s0
| s9, s10 => s0
| s9, s11 => s0
| s9, s12 => s0
| s9, s13 => s0
| s9, s14 => s0
| s9, s15 => s0
| s9, s16 => s0
| s9, s17 => s0
| s9, s18 => s0
| s9, s19 => s0
| s9, s20 => s0
| s9, s21 => s0
| s9, s22 => s0
| s9, s23 => s0
| s9, s24 => s0
| s9, s25 => s0
| s9, s26 => s0
| s9, s27 => s0
| s9, s28 => s0
| s9, s29 => s0
| s9, s30 => s0
| s9, s31 => s0
| s9, s32 => s0
| s9, s33 => s0
| s9, s34 => s0
| s10, s0 => s0
| s10, s1 => s0
| s10, s2 => s0
| s10, s3 => s0
| s10, s4 => s0
| s10, s5 => s0
| s10, s6 => s0
| s10, s7 => s0
| s10, s8 => s0
| s10, s9 => s0
| s10, s10 => s0
| s10, s11 => s0
| s10, s12 => s0
| s10, s13 => s0
| s10, s14 => s0
| s10, s15 => s0
| s10, s16 => s0
| s10, s17 => s0
| s10, s18 => s0
| s10, s19 => s0
| s10, s20 => s0
| s10, s21 => s0
| s10, s22 => s0
| s10, s23 => s0
| s10, s24 => s0
| s10, s25 => s0
| s10, s26 => s0
| s10, s27 => s0
| s10, s28 => s0
| s10, s29 => s0
| s10, s30 => s0
| s10, s31 => s0
| s10, s32 => s0
| s10, s33 => s0
| s10, s34 => s0
| s11, s0 => s0
| s11, s1 => s0
| s11, s2 => s0
| s11, s3 => s0
| s11, s4 => s0
| s11, s5 => s0
| s11, s6 => s0
| s11, s7 => s0
| s11, s8 => s0
| s11, s9 => s0
| s11, s10 => s0
| s11, s11 => s0
| s11, s12 => s0
| s11, s13 => s0
| s11, s14 => s0
| s11, s15 => s0
| s11, s16 => s0
| s11, s17 => s0
| s11, s18 => s0
| s11, s19 => s0
| s11, s20 => s0
| s11, s21 => s0
| s11, s22 => s0
| s11, s23 => s0
| s11, s24 => s0
| s11, s25 => s0
| s11, s26 => s0
| s11, s27 => s0
| s11, s28 => s0
| s11, s29 => s0
| s11, s30 => s0
| s11, s31 => s0
| s11, s32 => s0
| s11, s33 => s0
| s11, s34 => s0
| s12, s0 => s0
| s12, s1 => s0
| s12, s2 => s0
| s12, s3 => s0
| s12, s4 => s0
| s12, s5 => s0
| s12, s6 => s0
| s12, s7 => s0
| s12, s8 => s0
| s12, s9 => s0
| s12, s10 => s0
| s12, s11 => s0
| s12, s12 => s0
| s12, s13 => s0
| s12, s14 => s0
| s12, s15 => s0
| s12, s16 => s0
| s12, s17 => s0
| s12, s18 => s0
| s12, s19 => s0
| s12, s20 => s0
| s12, s21 => s0
| s12, s22 => s0
| s12, s23 => s0
| s12, s24 => s0
| s12, s25 => s0
| s12, s26 => s0
| s12, s27 => s0
| s12, s28 => s0
| s12, s29 => s0
| s12, s30 => s0
| s12, s31 => s0
| s12, s32 => s0
| s12, s33 => s0
| s12, s34 => s0
| s13, s0 => s0
| s13, s1 => s0
| s13, s2 => s0
| s13, s3 => s0
| s13, s4 => s0
| s13, s5 => s0
| s13, s6 => s0
| s13, s7 => s0
| s13, s8 => s0
| s13, s9 => s0
| s13, s10 => s0
| s13, s11 => s0
| s13, s12 => s0
| s13, s13 => s0
| s13, s14 => s0
| s13, s15 => s0
| s13, s16 => s0
| s13, s17 => s0
| s13, s18 => s0
| s13, s19 => s0
| s13, s20 => s0
| s13, s21 => s0
| s13, s22 => s0
| s13, s23 => s0
| s13, s24 => s0
| s13, s25 => s0
| s13, s26 => s0
| s13, s27 => s0
| s13, s28 => s0
| s13, s29 => s0
| s13, s30 => s0
| s13, s31 => s0
| s13, s32 => s0
| s13, s33 => s0
| s13, s34 => s0
| s14, s0 => s0
| s14, s1 => s0
| s14, s2 => s0
| s14, s3 => s0
| s14, s4 => s0
| s14, s5 => s0
| s14, s6 => s0
| s14, s7 => s0
| s14, s8 => s0
| s14, s9 => s0
| s14, s10 => s0
| s14, s11 => s0
| s14, s12 => s0
| s14, s13 => s0
| s14, s14 => s0
| s14, s15 => s0
| s14, s16 => s0
| s14, s17 => s0
| s14, s18 => s0
| s14, s19 => s0
| s14, s20 => s0
| s14, s21 => s0
| s14, s22 => s0
| s14, s23 => s0
| s14, s24 => s0
| s14, s25 => s0
| s14, s26 => s0
| s14, s27 => s0
| s14, s28 => s0
| s14, s29 => s0
| s14, s30 => s0
| s14, s31 => s0
| s14, s32 => s0
| s14, s33 => s0
| s14, s34 => s0
| s15, s0 => s0
| s15, s1 => s0
| s15, s2 => s0
| s15, s3 => s0
| s15, s4 => s0
| s15, s5 => s0
| s15, s6 => s0
| s15, s7 => s0
| s15, s8 => s0
| s15, s9 => s0
| s15, s10 => s0
| s15, s11 => s0
| s15, s12 => s0
| s15, s13 => s0
| s15, s14 => s0
| s15, s15 => s0
| s15, s16 => s0
| s15, s17 => s0
| s15, s18 => s0
| s15, s19 => s0
| s15, s20 => s0
| s15, s21 => s0
| s15, s22 => s0
| s15, s23 => s0
| s15, s24 => s0
| s15, s25 => s0
| s15, s26 => s0
| s15, s27 => s0
| s15, s28 => s0
| s15, s29 => s0
| s15, s30 => s0
| s15, s31 => s0
| s15, s32 => s0
| s15, s33 => s0
| s15, s34 => s0
| s16, s0 => s0
| s16, s1 => s0
| s16, s2 => s0
| s16, s3 => s0
| s16, s4 => s0
| s16, s5 => s0
| s16, s6 => s0
| s16, s7 => s0
| s16, s8 => s0
| s16, s9 => s0
| s16, s10 => s0
| s16, s11 => s0
| s16, s12 => s0
| s16, s13 => s0
| s16, s14 => s0
| s16, s15 => s0
| s16, s16 => s0
| s16, s17 => s0
| s16, s18 => s0
| s16, s19 => s0
| s16, s20 => s0
| s16, s21 => s0
| s16, s22 => s0
| s16, s23 => s0
| s16, s24 => s0
| s16, s25 => s0
| s16, s26 => s0
| s16, s27 => s0
| s16, s28 => s0
| s16, s29 => s0
| s16, s30 => s0
| s16, s31 => s0
| s16, s32 => s0
| s16, s33 => s0
| s16, s34 => s0
| s17, s0 => s0
| s17, s1 => s0
| s17, s2 => s0
| s17, s3 => s0
| s17, s4 => s0
| s17, s5 => s0
| s17, s6 => s0
| s17, s7 => s0
| s17, s8 => s0
| s17, s9 => s0
| s17, s10 => s0
| s17, s11 => s0
| s17, s12 => s0
| s17, s13 => s0
| s17, s14 => s0
| s17, s15 => s0
| s17, s16 => s0
| s17, s17 => s0
| s17, s18 => s0
| s17, s19 => s0
| s17, s20 => s0
| s17, s21 => s0
| s17, s22 => s0
| s17, s23 => s0
| s17, s24 => s0
| s17, s25 => s0
| s17, s26 => s0
| s17, s27 => s0
| s17, s28 => s0
| s17, s29 => s0
| s17, s30 => s0
| s17, s31 => s0
| s17, s32 => s0
| s17, s33 => s0
| s17, s34 => s0
| s18, s0 => s0
| s18, s1 => s0
| s18, s2 => s0
| s18, s3 => s0
| s18, s4 => s0
| s18, s5 => s0
| s18, s6 => s0
| s18, s7 => s0
| s18, s8 => s0
| s18, s9 => s0
| s18, s10 => s0
| s18, s11 => s0
| s18, s12 => s0
| s18, s13 => s0
| s18, s14 => s0
| s18, s15 => s0
| s18, s16 => s0
| s18, s17 => s0
| s18, s18 => s0
| s18, s19 => s0
| s18, s20 => s0
| s18, s21 => s0
| s18, s22 => s0
| s18, s23 => s0
| s18, s24 => s0
| s18, s25 => s0
| s18, s26 => s0
| s18, s27 => s0
| s18, s28 => s0
| s18, s29 => s0
| s18, s30 => s0
| s18, s31 => s0
| s18, s32 => s0
| s18, s33 => s0
| s18, s34 => s0
| s19, s0 => s0
| s19, s1 => s0
| s19, s2 => s0
| s19, s3 => s0
| s19, s4 => s0
| s19, s5 => s0
| s19, s6 => s0
| s19, s7 => s0
| s19, s8 => s0
| s19, s9 => s0
| s19, s10 => s0
| s19, s11 => s0
| s19, s12 => s0
| s19, s13 => s0
| s19, s14 => s0
| s19, s15 => s0
| s19, s16 => s0
| s19, s17 => s0
| s19, s18 => s0
| s19, s19 => s0
| s19, s20 => s0
| s19, s21 => s0
| s19, s22 => s0
| s19, s23 => s0
| s19, s24 => s0
| s19, s25 => s0
| s19, s26 => s0
| s19, s27 => s0
| s19, s28 => s0
| s19, s29 => s0
| s19, s30 => s0
| s19, s31 => s0
| s19, s32 => s0
| s19, s33 => s0
| s19, s34 => s0
| s20, s0 => s0
| s20, s1 => s0
| s20, s2 => s0
| s20, s3 => s0
| s20, s4 => s0
| s20, s5 => s0
| s20, s6 => s0
| s20, s7 => s0
| s20, s8 => s0
| s20, s9 => s0
| s20, s10 => s0
| s20, s11 => s0
| s20, s12 => s0
| s20, s13 => s0
| s20, s14 => s0
| s20, s15 => s0
| s20, s16 => s0
| s20, s17 => s0
| s20, s18 => s0
| s20, s19 => s0
| s20, s20 => s0
| s20, s21 => s0
| s20, s22 => s0
| s20, s23 => s0
| s20, s24 => s0
| s20, s25 => s0
| s20, s26 => s0
| s20, s27 => s0
| s20, s28 => s0
| s20, s29 => s0
| s20, s30 => s0
| s20, s31 => s0
| s20, s32 => s0
| s20, s33 => s0
| s20, s34 => s0
| s21, s0 => s0
| s21, s1 => s0
| s21, s2 => s0
| s21, s3 => s0
| s21, s4 => s0
| s21, s5 => s0
| s21, s6 => s0
| s21, s7 => s0
| s21, s8 => s0
| s21, s9 => s0
| s21, s10 => s0
| s21, s11 => s0
| s21, s12 => s0
| s21, s13 => s0
| s21, s14 => s0
| s21, s15 => s0
| s21, s16 => s0
| s21, s17 => s0
| s21, s18 => s0
| s21, s19 => s0
| s21, s20 => s0
| s21, s21 => s0
| s21, s22 => s0
| s21, s23 => s0
| s21, s24 => s0
| s21, s25 => s0
| s21, s26 => s0
| s21, s27 => s0
| s21, s28 => s0
| s21, s29 => s0
| s21, s30 => s0
| s21, s31 => s0
| s21, s32 => s0
| s21, s33 => s0
| s21, s34 => s0
| s22, s0 => s0
| s22, s1 => s0
| s22, s2 => s0
| s22, s3 => s0
| s22, s4 => s0
| s22, s5 => s0
| s22, s6 => s0
| s22, s7 => s0
| s22, s8 => s0
| s22, s9 => s0
| s22, s10 => s0
| s22, s11 => s0
| s22, s12 => s0
| s22, s13 => s0
| s22, s14 => s0
| s22, s15 => s0
| s22, s16 => s0
| s22, s17 => s0
| s22, s18 => s0
| s22, s19 => s0
| s22, s20 => s0
| s22, s21 => s0
| s22, s22 => s0
| s22, s23 => s0
| s22, s24 => s0
| s22, s25 => s0
| s22, s26 => s0
| s22, s27 => s0
| s22, s28 => s0
| s22, s29 => s0
| s22, s30 => s0
| s22, s31 => s0
| s22, s32 => s0
| s22, s33 => s0
| s22, s34 => s0
| s23, s0 => s0
| s23, s1 => s0
| s23, s2 => s0
| s23, s3 => s0
| s23, s4 => s0
| s23, s5 => s0
| s23, s6 => s0
| s23, s7 => s0
| s23, s8 => s0
| s23, s9 => s0
| s23, s10 => s0
| s23, s11 => s0
| s23, s12 => s0
| s23, s13 => s0
| s23, s14 => s0
| s23, s15 => s0
| s23, s16 => s0
| s23, s17 => s0
| s23, s18 => s0
| s23, s19 => s0
| s23, s20 => s0
| s23, s21 => s0
| s23, s22 => s0
| s23, s23 => s0
| s23, s24 => s0
| s23, s25 => s0
| s23, s26 => s0
| s23, s27 => s0
| s23, s28 => s0
| s23, s29 => s0
| s23, s30 => s0
| s23, s31 => s0
| s23, s32 => s0
| s23, s33 => s0
| s23, s34 => s0
| s24, s0 => s0
| s24, s1 => s0
| s24, s2 => s0
| s24, s3 => s0
| s24, s4 => s0
| s24, s5 => s0
| s24, s6 => s0
| s24, s7 => s0
| s24, s8 => s0
| s24, s9 => s0
| s24, s10 => s0
| s24, s11 => s0
| s24, s12 => s0
| s24, s13 => s0
| s24, s14 => s0
| s24, s15 => s0
| s24, s16 => s0
| s24, s17 => s0
| s24, s18 => s0
| s24, s19 => s0
| s24, s20 => s0
| s24, s21 => s0
| s24, s22 => s0
| s24, s23 => s0
| s24, s24 => s0
| s24, s25 => s0
| s24, s26 => s0
| s24, s27 => s0
| s24, s28 => s0
| s24, s29 => s0
| s24, s30 => s0
| s24, s31 => s0
| s24, s32 => s0
| s24, s33 => s0
| s24, s34 => s0
| s25, s0 => s0
| s25, s1 => s0
| s25, s2 => s0
| s25, s3 => s0
| s25, s4 => s0
| s25, s5 => s0
| s25, s6 => s0
| s25, s7 => s0
| s25, s8 => s0
| s25, s9 => s0
| s25, s10 => s0
| s25, s11 => s0
| s25, s12 => s0
| s25, s13 => s0
| s25, s14 => s0
| s25, s15 => s0
| s25, s16 => s0
| s25, s17 => s0
| s25, s18 => s0
| s25, s19 => s0
| s25, s20 => s0
| s25, s21 => s0
| s25, s22 => s0
| s25, s23 => s0
| s25, s24 => s0
| s25, s25 => s0
| s25, s26 => s0
| s25, s27 => s0
| s25, s28 => s0
| s25, s29 => s0
| s25, s30 => s0
| s25, s31 => s0
| s25, s32 => s0
| s25, s33 => s0
| s25, s34 => s0
| s26, s0 => s0
| s26, s1 => s0
| s26, s2 => s0
| s26, s3 => s0
| s26, s4 => s0
| s26, s5 => s0
| s26, s6 => s0
| s26, s7 => s0
| s26, s8 => s0
| s26, s9 => s0
| s26, s10 => s0
| s26, s11 => s0
| s26, s12 => s0
| s26, s13 => s0
| s26, s14 => s0
| s26, s15 => s0
| s26, s16 => s0
| s26, s17 => s0
| s26, s18 => s0
| s26, s19 => s0
| s26, s20 => s0
| s26, s21 => s0
| s26, s22 => s0
| s26, s23 => s0
| s26, s24 => s0
| s26, s25 => s0
| s26, s26 => s0
| s26, s27 => s0
| s26, s28 => s0
| s26, s29 => s0
| s26, s30 => s0
| s26, s31 => s0
| s26, s32 => s0
| s26, s33 => s0
| s26, s34 => s0
| s27, s0 => s0
| s27, s1 => s0
| s27, s2 => s0
| s27, s3 => s0
| s27, s4 => s0
| s27, s5 => s0
| s27, s6 => s0
| s27, s7 => s0
| s27, s8 => s0
| s27, s9 => s0
| s27, s10 => s0
| s27, s11 => s0
| s27, s12 => s0
| s27, s13 => s0
| s27, s14 => s0
| s27, s15 => s0
| s27, s16 => s0
| s27, s17 => s0
| s27, s18 => s0
| s27, s19 => s0
| s27, s20 => s0
| s27, s21 => s0
| s27, s22 => s0
| s27, s23 => s0
| s27, s24 => s0
| s27, s25 => s0
| s27, s26 => s0
| s27, s27 => s0
| s27, s28 => s0
| s27, s29 => s0
| s27, s30 => s0
| s27, s31 => s0
| s27, s32 => s0
| s27, s33 => s0
| s27, s34 => s0
| s28, s0 => s0
| s28, s1 => s0
| s28, s2 => s0
| s28, s3 => s0
| s28, s4 => s0
| s28, s5 => s0
| s28, s6 => s0
| s28, s7 => s0
| s28, s8 => s0
| s28, s9 => s0
| s28, s10 => s0
| s28, s11 => s0
| s28, s12 => s0
| s28, s13 => s0
| s28, s14 => s0
| s28, s15 => s0
| s28, s16 => s0
| s28, s17 => s0
| s28, s18 => s0
| s28, s19 => s0
| s28, s20 => s0
| s28, s21 => s0
| s28, s22 => s0
| s28, s23 => s0
| s28, s24 => s0
| s28, s25 => s0
| s28, s26 => s0
| s28, s27 => s0
| s28, s28 => s0
| s28, s29 => s0
| s28, s30 => s0
| s28, s31 => s0
| s28, s32 => s0
| s28, s33 => s0
| s28, s34 => s0
| s29, s0 => s0
| s29, s1 => s0
| s29, s2 => s0
| s29, s3 => s0
| s29, s4 => s0
| s29, s5 => s0
| s29, s6 => s0
| s29, s7 => s0
| s29, s8 => s0
| s29, s9 => s0
| s29, s10 => s0
| s29, s11 => s0
| s29, s12 => s0
| s29, s13 => s0
| s29, s14 => s0
| s29, s15 => s0
| s29, s16 => s0
| s29, s17 => s0
| s29, s18 => s0
| s29, s19 => s0
| s29, s20 => s0
| s29, s21 => s0
| s29, s22 => s0
| s29, s23 => s0
| s29, s24 => s0
| s29, s25 => s0
| s29, s26 => s0
| s29, s27 => s0
| s29, s28 => s0
| s29, s29 => s0
| s29, s30 => s0
| s29, s31 => s0
| s29, s32 => s0
| s29, s33 => s0
| s29, s34 => s0
| s30, s0 => s0
| s30, s1 => s0
| s30, s2 => s0
| s30, s3 => s0
| s30, s4 => s0
| s30, s5 => s0
| s30, s6 => s0
| s30, s7 => s0
| s30, s8 => s0
| s30, s9 => s0
| s30, s10 => s0
| s30, s11 => s0
| s30, s12 => s0
| s30, s13 => s0
| s30, s14 => s0
| s30, s15 => s0
| s30, s16 => s0
| s30, s17 => s0
| s30, s18 => s0
| s30, s19 => s0
| s30, s20 => s0
| s30, s21 => s0
| s30, s22 => s0
| s30, s23 => s0
| s30, s24 => s0
| s30, s25 => s0
| s30, s26 => s0
| s30, s27 => s0
| s30, s28 => s0
| s30, s29 => s0
| s30, s30 => s0
| s30, s31 => s0
| s30, s32 => s0
| s30, s33 => s0
| s30, s34 => s0
| s31, s0 => s0
| s31, s1 => s0
| s31, s2 => s0
| s31, s3 => s0
| s31, s4 => s0
| s31, s5 => s0
| s31, s6 => s0
| s31, s7 => s0
| s31, s8 => s0
| s31, s9 => s0
| s31, s10 => s0
| s31, s11 => s0
| s31, s12 => s0
| s31, s13 => s0
| s31, s14 => s0
| s31, s15 => s0
| s31, s16 => s0
| s31, s17 => s0
| s31, s18 => s0
| s31, s19 => s0
| s31, s20 => s0
| s31, s21 => s0
| s31, s22 => s0
| s31, s23 => s0
| s31, s24 => s0
| s31, s25 => s0
| s31, s26 => s0
| s31, s27 => s0
| s31, s28 => s0
| s31, s29 => s0
| s31, s30 => s0
| s31, s31 => s0
| s31, s32 => s0
| s31, s33 => s0
| s31, s34 => s0
| s32, s0 => s0
| s32, s1 => s0
| s32, s2 => s0
| s32, s3 => s0
| s32, s4 => s0
| s32, s5 => s0
| s32, s6 => s0
| s32, s7 => s0
| s32, s8 => s0
| s32, s9 => s0
| s32, s10 => s0
| s32, s11 => s0
| s32, s12 => s0
| s32, s13 => s0
| s32, s14 => s0
| s32, s15 => s0
| s32, s16 => s0
| s32, s17 => s0
| s32, s18 => s0
| s32, s19 => s0
| s32, s20 => s0
| s32, s21 => s0
| s32, s22 => s0
| s32, s23 => s0
| s32, s24 => s0
| s32, s25 => s0
| s32, s26 => s0
| s32, s27 => s0
| s32, s28 => s0
| s32, s29 => s0
| s32, s30 => s0
| s32, s31 => s0
| s32, s32 => s0
| s32, s33 => s0
| s32, s34 => s0
| s33, s0 => s0
| s33, s1 => s0
| s33, s2 => s0
| s33, s3 => s0
| s33, s4 => s0
| s33, s5 => s0
| s33, s6 => s0
| s33, s7 => s0
| s33, s8 => s0
| s33, s9 => s0
| s33, s10 => s0
| s33, s11 => s0
| s33, s12 => s0
| s33, s13 => s0
| s33, s14 => s0
| s33, s15 => s0
| s33, s16 => s0
| s33, s17 => s0
| s33, s18 => s0
| s33, s19 => s0
| s33, s20 => s0
| s33, s21 => s0
| s33, s22 => s0
| s33, s23 => s0
| s33, s24 => s0
| s33, s25 => s0
| s33, s26 => s0
| s33, s27 => s0
| s33, s28 => s0
| s33, s29 => s0
| s33, s30 => s0
| s33, s31 => s0
| s33, s32 => s0
| s33, s33 => s0
| s33, s34 => s0
| s34, s0 => s0
| s34, s1 => s0
| s34, s2 => s0
| s34, s3 => s0
| s34, s4 => s0
| s34, s5 => s0
| s34, s6 => s0
| s34, s7 => s0
| s34, s8 => s0
| s34, s9 => s0
| s34, s10 => s0
| s34, s11 => s0
| s34, s12 => s0
| s34, s13 => s0
| s34, s14 => s0
| s34, s15 => s0
| s34, s16 => s0
| s34, s17 => s0
| s34, s18 => s0
| s34, s19 => s0
| s34, s20 => s0
| s34, s21 => s0
| s34, s22 => s0
| s34, s23 => s0
| s34, s24 => s0
| s34, s25 => s0
| s34, s26 => s0
| s34, s27 => s0
| s34, s28 => s0
| s34, s29 => s0
| s34, s30 => s0
| s34, s31 => s0
| s34, s32 => s0
| s34, s33 => s0
| s34, s34 => s0
set_option maxHeartbeats 0

example : ∀ x y z, f (f (f s0 x) y) z = f (f x z) (f y z) := by
 native_decide