import model_theory.substructures
import model_theory.bundled

--OUTPUT 1
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let Γ := F.fold
    ((λ (x : first_order.prop L) (y : L.Theory), y.union {x.to_true_logic_formula}) ∘
    (λ (x : first_order.predicate L) (y : L.Theory), y.union
    (λ (n : ℕ), {∃ (a1 : F.Model.σ), ∃ (a2 : F.Model.σ), ∃ (a3 : F.Model.σ), ∃ (L : F.Model.σ → F.Model.σ), ∃ (R : F.Model.σ → F.Model.σ),
      (∃* (a1 a2) (x.relation_symbol 2)) ∧ ¬ ((∃*)* (a1 a3) (x.relation_symbol 2)) ∧ ¬ ((∃*)* (a2 a3) (x.relation_symbol 2)) ∧
      ((∀* (b : F.Model.σ), (L b =* a1 ∧ R b =* a2) ∨ (L b =* a2 ∧ R b =* a3) ∨ (L b =* a1 ∧ R b =* a3))) ∧
      ((∀* (b : F.Model.σ), ¬ ((∃*)* (L b) (x.relation_symbol 1))) ∧ (∀* (b : F.Model.σ), ¬ ((∃*)* (R b) (x.relation_symbol 1))) ∧
      ((∀* (b : F.Model.σ), (L b =* b) ∨ (R b =* b)) ∨ (∀* (b : F.Model.σ), ¬ ((∃*)* (b) (x.relation_symbol 1)))))} n))) F,
  have h1 : ∀ n : ℕ, ∃ (M : F.Model) [mfin : fintype M], M ⊧ Γ n, from by {
    assume n : ℕ,
    let A := (λ (n : ℕ), {∃ (a1 : F.Model.σ), ∃ (a2 : F.Model.σ), ∃ (a3 : F.Model.σ), ∃ (L : F.Model.σ → F.Model.σ), ∃ (R : F.Model.σ → F.Model.σ),
      (∃* (a1 a2) (x.relation_symbol 2)) ∧ ¬ ((∃*)* (a1 a3) (x.relation_symbol 2)) ∧ ¬ ((∃*)* (a2 a3) (x.relation_symbol 2)) ∧
      ((∀* (b : F.Model.σ), (L b =* a1 ∧ R b =* a2) ∨ (L b =* a2 ∧ R b =* a3) ∨ (L b =* a1 ∧ R b =* a3))) ∧
      ((∀* (b : F.Model.σ), ¬ ((∃*)* (L b) (x.relation_symbol 1))) ∧ (∀* (b : F.Model.σ), ¬ ((∃*)* (R b) (x.relation_symbol 1))) ∧
      ((∀* (b : F.Model.σ), (L b =* b) ∨ (R b =* b)) ∨ (∀* (b : F.Model.σ), ¬ ((∃*)* (b) (x.relation_symbol 1)))))} n),
    let B := λ (n : ℕ), F.fold
    ((λ (x : first_order.prop L) (y : L.Theory), y.union {x.to_true_logic_formula}) ∘
    (λ (x : first_order.predicate L) (y : L.Theory), y.union A)) F n,
    have h2 : B n ⊆ Γ n, from by
      apply subset.trans (λ (x : first_order.formula L), subset_union.mpr ⟨by {intros,simp [B,A],from λ a b,by {apply F.mem_fold_right}},
        by {intros, simp [B,A],from λ a b,by {apply F.mem_fold_right}}⟩) subset_union_right,
    have h3 : ∃ (M : F.Model) [mfin : fintype M], M ⊧ B n, from by
      apply fintype.induction_on (h n).right (λ a,
        begin
          {
            let a3 := mk F.Model (a.val ∪ {a1,a2,a3,L,R}),
            have h3 : (∃ (a1 : F.Model.σ), ∃ (a2 : F.Model.σ), ∃ (a3 : F.Model.σ), ∃ (L : F.Model.σ → F.Model.σ), ∃ (R : F.Model.σ → F.Model.σ), (∃* (a1 a2) (x.relation_symbol 2)) ∧ ¬ ((∃*)* (a1 a3) (x.relation_symbol 2)) ∧ ¬ ((∃*)* (a2 a3) (x.relation_symbol 2)) ∧ ((∀* (b : F.Model.σ), (L b =* a1 ∧ R b =* a2) ∨ (L b =* a2 ∧ R b =* a3) ∨ (L b =* a1 ∧ R b =* a3))) ∧ ((∀* (b : F.Model.σ), ¬ ((∃*)* (L b) (x.relation_symbol 1))) ∧ (∀* (b : F.Model.σ), ¬ ((∃*)* (R b) (x.relation_symbol 1))) ∧ ((∀* (b : F.Model.σ), (L b =* b) ∨ (R b =* b)) ∨ (∀* (b : F.Model.σ), ¬ ((∃*)* (b) (x.relation_symbol 1)))))), from
              have h3 : ∀ x y, x ≠ y → ¬ (∃* (a1 x) (x.relation_symbol 1) ∧ ∃* (a1 y) (x.relation_symbol 1)), from assume x y h12,
                begin
                  apply not_and.mp,
                  suffices : ¬ ∃* (a1 x) (x.relation_symbol 1) ∨ ¬ ∃* (a1 y) (x.relation_symbol 1), from or_not_and.mp this,
                  suffices : ¬ (∃* (a1 x) (x.relation_symbol 1) ∧ ∃* (a1 y) (x.relation_symbol 1)), from by {split,assumption, assumption,},
                  simp [h12],
                end,
              have h4 : ∀ x y, x ≠ y → ¬ (∃* (a2 x) (x.relation_symbol 1) ∧ ∃* (a2 y) (x.relation_symbol 1)), from assume x y h12,
                begin
                  apply not_and.mp,
                  suffices : ¬ ∃* (a2 x) (x.relation_symbol 1) ∨ ¬ ∃* (a2 y) (x.relation_symbol 1), from or_not_and.mp this,
                  suffices : ¬ (∃* (a2 x) (x.relation_symbol 1) ∧ ∃* (a2 y) (x.relation_symbol 1)), from by {split,assumption, assumption,},
                  simp [h12],
                end,
              have h5 : ∀ (b : F.Model.σ), ∃ (a1 : F.Model.σ), ∃ (a2 : F.Model.σ), ∃ (a3 : F.Model.σ), ∃ (L : F.Model.σ → F.Model.σ), ∃ (R : F.Model.σ → F.Model.σ), (∃* (a1 a2) (x.relation
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∀ n : ℕ, ∃ (m : F.Model) (h1 : n ≤ fintype.card m), first_order.Model.sat_of_mem L.Theory.rel_model (@first_order.Model.rel_sat L F.Model) F.Model.rel m (F.Model.model_to_set m) (encode_model_of_model m),
  from assume n : ℕ,
    let ⟨M, hM⟩ := h n in
    let ⟨m : F.Model, h1, h2⟩ := F.Model.encode hM in
    have h3 : sat_of_mem F.Theory.rel_model F.Model.rel_sat m (F.Model.model_to_set m), from h2,
    ⟨m, h1, h3⟩,
  have h2 : ∃ (M : F.Model), ∀ n : ℕ, n ≤ fintype.card M, from by {
    apply first_order.compactness h1,
    have h3 : ∀ x : F.Model, first_order.Model.sat_of_mem L.Theory.rel_model F.Model.rel_sat x (F.Model.model_to_set x) → finite x, from
      assume x : F.Model,
      assume h3 : sat_of_mem F.Theory.rel_model F.Model.rel_sat x (F.Model.model_to_set x),
      have h4 : finite (F.Model.model_to_set x), from assume s : set F.Lang.symbol, ⟨@F.Model.Model_to_Set.mk_struct
        (@first_order.Model.Model_to_Set.mk_struct x s) h3,@F.Model.Model_to_Set.mk_struct
        (@first_order.Model.Model_to_Set.mk_struct x s) h3⟩,
      show finite x, from fintype.of_finset (finset.coe_to_finset $ F.Model.model_to_set x),

    show finite (F.Model.model_to_set _), from @h3 _ _,
  },
  let ⟨M, hM⟩ := h2 in
  have h3 : ∃ (n : ℕ), n ≤ fintype.card M ∧ n ≥ fintype.card M, from by {
    let ⟨n, hn⟩ := classical.axiom_of_infinitude M in
    use n, apply and.intro hn,
    have h4 : finite M, from by {
      have h4 : F.Model.sat_of_mem L.Theory.rel_model F.Model.rel_sat M (F.Model.model_to_set M), from hM M,
      have h5 : finite (F.Model.model_to_set M), from assume s : set F.Lang.symbol, ⟨@F.Model.Model_to_Set.mk_struct
        (@first_order.Model.Model_to_Set.mk_struct M s) h4,@F.Model.Model_to_Set.mk_struct
        (@first_order.Model.Model_to_Set.mk_struct M s) h4⟩,
      show finite (M), from fintype.of_finset (finset.coe_to_finset $ F.Model.model_to_set M),
    },
    exact le_of_not_gt hn h4,
  },
  let ⟨n, hn⟩ := h3 in
  have h4 : n = fintype.card M, from le_antisymm hn.right hn.left,
  have h5 : infinite M, from by {
    have h5 : ∀ m : F.Model, fintype.card M = fintype.card m → m.type = M.type, from assume m : F.Model, by {
      assume h5 : fintype.card M = fintype.card m,
      have h6 : m.type = M.type, from (M.injective M.to_set M.to_set),
      show m.type = M.type, from h6,
    },
    refine ⟨by {
      have h6 : M.type = M.type, from eq.refl M.type,
      have h7 : (M.type).to_set = M.type.to_set, from rfl,
      have h8 : M.type.to_set = M.type.to_set, from rfl,
      have h9 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from assume n : ℕ, by {
        use M, split, use mfin, exact le_refl n,
      },
      have h10 : ∃ (M : F.Model) [mfin : fintype M], ∀ n : ℕ, n ≤ @fintype.card M mfin, from h9 _,
      let ⟨N, hN⟩ := h10 in
      let ⟨m : F.Model, hm, hm2⟩ := F.Model.encode hN in
      have h11 : M.type = m.type, from h5 m (h4.symm ▸ hm2),
      have h12 : F.Model.Model_to_Set.to_model M.type = F.Model.Model_to_Set.to_model m.type, from by {
        rw ← h11,

        have h13 : F.Model.Model_to_Set.to_model M.type.to_set = M, from rfl,
        have h14 : F.Model.Model_to_Set.to_model m.type.to_set = m, from rfl,

        have h15 : M.to_set = m.to_set, from eq.trans h12 h13.symm,
        have h16 : (M.type).to_set = m.to_set, from eq.trans h7.symm h15,
        have h17 : (M.type).to_set = m.type.to_set, from eq.trans h11.symm h16,
        have h18 : (M.type).to_set.to_set = m.type.to_set, from h17,
        show F.Model.Model_to_Set.to_model (M.type).to_set = F.Model.Model_to_Set.to_model m.type.to_set, from
        eq.trans (F.Model.Model_to_Set.mk_struct h8.symm) (eq.trans (@F.Model.Model_to_Set.to_model M.type (M.type).to_set).symm (eq.trans (F.Model.Model_to_Set.mk_struct h18) (@F.Model.Model_to_Set.to_model m.type m.type.to_set))),
      },
      have h13 : M.type = F.Model.Model_to_Set.to_model M.type.to_set, from rfl,
      have h14 : M.type = M, from eq.trans (eq.trans h13.symm h12) h13,
      show (M.type).to_set = M.to_set, from eq.trans (h11.symm ▸ h7) (eq.trans h8.symm h14),
    }⟩,
  },
  use M, use h5,
end

--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
  assume L : first_order.language,
  assume F : L.Theory,
  assume h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin,
  have h0 : ∀ ⦃L : first_order.language⦄ {F : L.Theory} [decidable_pred (F.Model.relations)] ⦃n : ℕ⦄, (∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) → ∃ (M : F.Model) [hM : infinite M], n ≤ @fintype.card M hM, from by {
    assume L : first_order.language,
    assume F : L.Theory,
    assume h : decidable_pred (F.Model.relations),
    assume n : ℕ,
    assume hn : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin,
    cases hn with m hm,
    cases hm with hmfin hmn,
    use (m : F.Model),
    show infinite m, from @infinite_of_finite_nat' L F h m hmfin hmn,
    show n ≤ @fintype.card m _, from hmn,
  },
  cases (classical.choice (λ n : ℕ, ∃ (M : F.Model) [hM : infinite M], n ≤ @fintype.card M hM)) with n hn,
  have h1 : ∃ (M : F.Model) [hM : infinite M], n ≤ @fintype.card M hM, from h0 _ (h n),
  cases h1 with M hM,
  use M,
  show infinite M, from hM.left,
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 $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 $A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.
 -/
  have A_n : L.formula, from by {
    let vars : L.Variables := L.Variables.mk $ λ (x), x.name ≠ ``0 ∧ x.arity = 0,
    let prefix : L.Formula_Prefix := L.Formula_Prefix.mk $ λ (x), x.name ≠ ``0 ∧ x.arity = 0,
    let φ : L.formula := L.formula.mk $ λ (x), x.name ≠ ``0 ∧ x.arity = 0,
    let qvars : L.Variables := L.Variables.mk $ λ (x), x.name ≠ ``0 ∧ x.arity = 0,
    let bvars : L.Variables := L.Variables.mk $ λ (x), x.name ≠ ``0 ∧ x.arity = 0,
    have h0 : ∀ (x : L.Var) (h1 : (x : L.Variables) ∈ qvars), x.name ≠ ``0 ∧ x.arity = 0, from by simp [h1.1,h1.2],
    have h1 : ∀ (x : L.Var) (h2 : (x : L.Variables) ∈ vars), x.name ≠ ``0 ∧ x.arity = 0, from by {
      assume x h2,
      have h3 : (x : L.Variables) ∈ qvars, from by {
        simp [h2.1,h2.2,bvars],
        simp [vars,lvars] at h2,
      },
      apply h0 _ h3,
    },
    have h2 : ∀ (x : L.Var) (h3 : (x : L.Variables) ∈ prefix), x.name ≠ ``0 ∧ x.arity = 0, from by {
      assume x h3,
      have h4 : (x : L.Variables) ∈ vars, from by {
        simp [h3.1,h3.2,qvars],
        simp [lvars,vars] at h3,
      },
      apply h1 _ h4,
    },
    have h3 : ∀ (x : L.Var) (h4 : (x : L.Variables) ∈ φ), x.name ≠ ``0 ∧ x.arity = 0, from by { apply h2, },
    exact L.formula.mk h3,
  },
  let Γ : Type* := fintype.finset (F.Model),
  /- 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.
  -/
  have finite_model_exists : F.Model, from by {
    have h0 : ∃ (M : F.Model) [mfin : fintype M], 0 ≤ @fintype.card M mfin, from by simp,
    exact classical.choice h0,
  },

  have overflowed : ∀ (n : ℕ), ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, from by {
    assume n : ℕ,
    use finite_model_exists,
    exact ⟨by obviously⟩,
  },
  have ∀ (n : ℕ), (∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin), from by exact overflowed,

  /- From the Compactness Theorem, $\Gamma$ is satisfiable in some model $\mathbf{M}$.
  -/
  have h_compactness : ∃ (m : F.Model), ∀ (h : m ∈ Γ), F.Model.satisfies m h, from by {
    admit,
  },
  have M_exists : F.Model, from classical.choice h_compactness,
  let M : F.Model := M_exists,
  have M_satisfies : ∀ (h : M ∈ Γ), F.Model.satisfies M h, from by {
    apply classical.choice h_compactness,
  },
  have M_satisfies_all_formulas : F.Model.satisfies M 𝟙, from begin
    have h0 : M ∈ Γ, from by simp [M,Γ,fintype.eqv'],
    have h1 : F.Model.satisfies M h0, from M_satisfies h0,
    have h2 : ∀ (h : Γ), F.Model.satisfies M h, from by {exact M_satisfies,},
    simp [M,h1,h2,fintype.eqv],
  end,

  /- But since $\mathbf{M} \models A_i$ for each $i$, $\mathbf{M}$ must be infinite.
  -/
  have M_is_infinite : infinite M, from begin
    have h0 : ∃ a : M, ∀ b : M, a ≠ b, from by {
      have h0 : ∀ (n : ℕ), ∃ a : M, ∀ b : M, a ≠ b, from begin
        /-
        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\}$
        -/
        assume n : ℕ,
        have h1 : (1 : ℚ) ≤ (n : ℚ), from by ring,
        have h2 : n ≤ n + 1 := by apply le_succ,
        have h3 : (1 : ℚ) ≤ (n + 1 : ℚ), from by apply le_trans h1 h2,
        have h4 : (n : ℚ) ≤ (n + 1 : ℚ), from by ring,
        have h5 : (n : ℝ) ≤ (n + 1 : ℝ), from by apply @rat.cast_le ℚ,
        have h6 : (n : ℝ) < (n + 1 : ℝ), from by apply lt_succ_iff.mp h5,
        have h7 : ((n + 1) : ℕ) < (n + 2), from by apply lt_succ_iff.mpr h6,
        have h8 : n < n + 2, from by apply nat.lt_succ_iff.mp h7,
        /- Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.
        -/
        have h9 : ∃ (M : F.Model) [mfin : fintype M], (n :ℕ) ≤ fintype.card M, from by {
          have h9 : ∃ (M : F.Model) [mfin : fintype M], (n :ℕ) ≤ @fintype.card M mfin, from by {
            apply overflowed,
          },
          exact h9,
        },
        have h10 : ∃ (M : F.Model) [mfin : fintype M], n + 2 ≤ @fintype.card M mfin := by {
          let M : F.Model := classical.choice h9,
          have mfin : fintype M, from classical.choice h
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
  have h1 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm' : m' ≃ m], n ≤ @fintype.card m' mfin'), from
    assume n : ℕ,
    begin
      have h2 : ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin, by apply h,
      have h3 : ∀ (m : F.Model) [mfin : fintype m], ∃ [mm' : m ≃ m], n ≤ @fintype.card m mfin, from
        assume (m : F.Model) [mfin : fintype m], let ⟨pm,hp⟩ := mfin.equiv_fin, let mm' : m ≃ m := ⟨pm,hp⟩, ⟨mm'⟩,
      have h4 : ∃ (m : F.Model) [mfin : fintype m] [mm' : m ≃ m], n ≤ @fintype.card m mfin, from exists_imp_exists _ h3,
      have h5 : ∃ (m : F.Model) [mfin : fintype m] [mm' : m ≃ m], n ≤ @fintype.card m mfin', from exists_imp_exists _ h4,
      exact h5,
    end,
  have h2 : ∀ n : ℕ, ∃ (a : F.Model) [mfin : fintype a] [ma : a ⊧ L.A n], n ≤ @fintype.card a mfin, from
    assume n : ℕ, begin
      have h3 : ∃ (m : F.Model) [mfin : fintype m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm' : m' ≃ m], n ≤ @fintype.card m' mfin'), from (h1 n),
      have h4 : ∃ a [mfin : fintype a] [mm' : a ≃ a], (∀ (m : F.Model) [mfin' : fintype m] [mm : m ≃ a], n ≤ @fintype.card m mfin'), from
        exists_imp_exists_const (λ (m : F.Model) [mfin : fintype m], ∀ (m' : F.Model) [mfin' : fintype m'] [mm : m' ≃ m], n ≤ @fintype.card m' mfin') h3,
      have h5 : ∃ a [mfin : fintype a] [mm' : a ≃ a], (∀ (m : F.Model) [mfin' : fintype m] [mm : a ≃ m], n ≤ @fintype.card m mfin'), from exists_imp_exists_const (λ (m : F.Model) [mfin' : fintype m], ∀ [mm : a ≃ m], n ≤ @fintype.card m mfin') h4,
      have h6 : ∃ a [mfin : fintype a] [mm' : a ≃ a], (∀ (m : F.Model) [mfin' : fintype m] [mm : a ≃ m], n ≤ @fintype.card a mfin), from exists_imp_exists_const (λ (m : F.Model) [mfin' : fintype m], n ≤ @fintype.card a mfin) h5,
      have h7 : ∃ (m : F.Model) [mfin : fintype m] [mm' : m ≃ m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm : m ≃ m'], n ≤ @fintype.card m' mfin'), from
      begin
        have h8 : ∃ (a : F.Model) [mfin : fintype a] [mm' : a ≃ a], (∀ (m : F.Model) [mfin' : fintype m] [mm : a ≃ m], n ≤ @fintype.card a mfin), from h6,
        exact exists_imp_exists_const (λ (m : F.Model) [mfin' : fintype m], ∀ [mm : m ≃ a], n ≤ @fintype.card m mfin') h8,
      end,
      have h8 : ∃ (m : F.Model) [mfin : fintype m] [mm' : m ≃ m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm : m ≃ m'], n ≤ @fintype.card m mfin'), from exists_imp_exists_const (λ (m : F.Model) [mfin' : fintype m], n ≤ @fintype.card m mfin') h7,
      have h9 : ∃ (m : F.Model) [mfin : fintype m] [mm' : m ≃ m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm : m ≃ m'], n ≤ @fintype.card m mfin) ∧ (∀ (m' : F.Model) [mfin' : fintype m'] [mm : m ≃ m'], m' ⊧ L.A n), from exists_imp_exists_const (λ (m : F.Model) [mfin : fintype m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm : m ≃ m'], m' ⊧ L.A n)) h8,
      exact h9,
    end,
  have h3 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm' : m ≃ m'], n ≤ @fintype.card m mfin) ∧ (∀ n : ℕ, m ⊧ L.A n), from
    assume n : ℕ, begin
      have h3 : ∃ (m : F.Model) [mfin : fintype m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm' : m ≃ m'], n ≤ @fintype.card m mfin), from h2 n,
      have h4 : ∃ (m : F.Model) [mfin : fintype m], (∃ [mm' : m ≃ m], n ≤ @fintype.card m mfin), from
        exists_imp_exists_const (λ (m : F.Model) [mfin : fintype m], ∃ [mm : m ≃ m], n ≤ @fintype.card m mfin) h3,
      have h5 : ∃ (m : F.Model) [mfin : fintype m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm : m' ≃ m], n ≤ @fintype.card m mfin) ∧ (∀ n : ℕ, m ⊧ L.A n), from
        exists_imp_exists_const (λ (m : F.Model) [mfin : fintype m], (∀ n : ℕ, m ⊧ L.A n)) h4,
      exact h5,
    end,
  have h4 : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm : m' ≃ m], m' ⊧ F ∧ (∀ n : ℕ, m' ⊧ L.A n)), from
    assume n : ℕ, begin
      have h5 : ∃ (m : F.Model) [mfin : fintype m], (∀ (m' : F.Model) [mfin' : fintype m'] [mm : m' ≃
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  use (F.Model.empty),
  sorry
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
  assume L F (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin),
  use [L,F], split,
  assume (n : ℕ), let L' := L.add_sorts (n + 3) in
  let F' := F.add_variables (n + 3) in
  let g := function.update (finset.range n) (λ i : fin (n + 3), 0) (n + 1) in
  let h := function.update (finset.range n) (λ i : fin (n + 3), 0) (n + 2) in
  let i := function.update (finset.range n) (λ i : fin (n + 3), 0) (n + 3) in
  let G := function.update (finset.range n) (λ i : fin (n + 3), 0) (n + 4) in
  let Γ := L'
  in
  let φ := (∃(g),
  (∃(h),
  (∃(i),
  (∃(G),
   ((∀(x),
    (∃(g),
    (∃(h),
    (∃(i),
    (∃(G),
    (∀(x),
    (∀(g),
    (∀(h),
    (∀(i),
    (∀(G),
    ((∀(x),
    (∀(g),
    (∀(h),
    ((neg (g = h)) ∧ (neg (h = i)) ∧ (neg (g = i))))))) ∧
    (∀(x),
    (∀(g),
    (∀(h),
    (∀(i),
    (∀(G),
    ((x < i) = (x < G)))))))))))))))))))))))))) ∧
    (∀(x),
    (∀(g),
    (∀(h),
    (∀(i),
    (∀(G),
    ((g < h) = (g < i)))))))) ∧
  (∀(x),
  (∀(g),
  (∀(h),
  (∀(i),
  (∀(G),
  ((x = i) = (x = G)))))))) ∧
  (∀(x),
  (∀(g),
  (∀(h),
  (∀(i),
  (∀(G),
  ((x = i) = (x = G)))))))) ∧
  (∀(x),
  (∀(g),
  (∀(h),
  (∀(i),
  (∀(G),
  ((x = i) = (x = G)))))))) ∧
  (∀(x),
  (∀(g),
  (∀(h),
  (∀(i),
  (∀(G),
  ((x = i) = (x = G)))))))) ∧
  (∀(x),
  (∀(g),
  (∀(h),
  (∀(i),
  (∀(G),
  ((x = i) = (x = G))))))))) in
  show ∃ (M : F'.Model), infinite M, from
  begin
    have h1 : ∀ n : ℕ, ∃ (m : F'.Model) [mfin : fintype m], n ≤ @fintype.card m mfin,
    from by {
      assume n,
      cases h n,
      use F'.Model.add_variables h_w,
      use [n, h_h],
      rw add_comm, exact h_w_1,
    },
    have h2 : ∀ n : ℕ, ∃ (m : F'.Model), n ≠ @fintype.card m,
    from by {
      assume (n : ℕ),
      cases h1 n,
      use g,
      have h5 : @fintype.card g ≠ n, from by rw [←(card_insert_of_not_mem @@ set.not_mem_range_self _ _)],
      have h6 : fintype.card g ≠ n, from by rw [fintype.card_eq_nat_card, ← h5], show n ≠ @fintype.card g, from not_congr h6,
    },
    have h3 : ∀ f : F'.Model, ∃ g : F'.Model, fintype.card g = fintype.card f + 1,
    from by {
      assume f,
      have h5 : @fintype.card f < @fintype.card (fintype.card f + 1), from by {
        rw [←nat.add_sub_cancel' (@fintype.card f), nat.sub_lt_iff_lt_add' (fintype.card_pos _)],
      },
      let g := (fintype.card f + 1),
      have h6 : ∃ (m : F'.Model), g ≠ @fintype.card m, from by {
        cases h2 g,
        use h_w, apply not_congr h_h,
      },
      cases h2 g,
      use h_w,
      apply h_h,
    },
    have h4 : F'.Theory.infinite_model φ := by {
      apply F'.Model.infinite_model_of_card_succ h3,},
    use h4,
  end
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
  let A_1 : L.formula := ∃ (x : L.sort) (y : L.sort),  x ≠ y,
  let A_2 : L.formula := ∃ (x : L.sort) (y : L.sort) (z : L.sort), x ≠ y ∧ x ≠ z ∧ y ≠ z,
  let A_3 : L.formula := ∃ (x : L.sort) (y : L.sort) (z : L.sort) (w : L.sort), x ≠ y ∧ x ≠ z ∧ x ≠ w ∧ y ≠ z ∧ y ≠ w ∧ z ≠ w,
  -- continue with other A_n, or just say "define A_n inductively"
  let A_n : L.formula := λ (n : ℕ), sorry,
  let Gamma : set L.formula := F.theory.to_set.cup (set.range A_n),
  sorry,
end

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

/--`theorem`
Any enumeration of the positive integers is eventually periodic.
`proof`
By the Pigeonhole Principle, the positive integers must be eventually periodic.

This is because we can map each positive integer to its index in the enumeration, which is a bijection.
{{qed}}
-/
theorem pigeonhole (n : ℕ) : ∃ (p : ℕ), ∀ (m : ℕ), m ≥ p → m % n = n % n := by sorry
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 := by {

let Aₙ := λ (n : ℕ), first_order.Theory.has_model F
  (first_order.existsn (n : ℕ) (first_order.var 0) ∧
  first_order.bigand (n - 1) (λ n : ℕ,
   first_order.∀' first_order.var (n+1) (first_order.var 0) (ne first_order.var 1) ∧
   first_order.impl (n ≠ 0) (first_order.∀' first_order.var (n+1) (first_order.var n) (ne first_order.var (n+1))))),

 let hₙ₊₁₋ₙₖ := by {intros, rw succ_sub, rw add_comm,simp},
 let hₙ₊₁₋ₙₖ₊₁ := by {intros, rw succ_sub, rw add_comm,rw succ_sub, rw add_comm,simp},
 let hₖ₊₁ := by {intros, rw succ_sub, rw add_comm,simp},
 let Γ := (first_order.Theory.has_model.map Aₙ) h,

 have h0 : (∀ n : ℕ, Γ n), from by {intros, simp [Γ],},
 have h1 : (ty), from by {
   have h1 : ((∀ n : ℕ, Γ n)), from by {intros, from h0 _,},
   have h2 : (has_finite.finite Γ), from by {apply _,},
   have h3 : (∃ (m : F.Model) [mfin : fintype m], nat.find (λ n, Γ n)), from by {exact h2,},
   have h4 : (∃ (m : F.Model) [mfin : fintype m], nat.find (λ n, Γ n)), from by {exact h3,},},

have h2 : (has_finite.finite Γ), from by {apply _,},
have h3 : (∃ (m : F.Model) [mfin : fintype m], nat.find (λ n, Γ n)), from by {exact h2,},
have h4 : (∃ (m : F.Model) [mfin : fintype m], nat.find (λ n, Γ n)), from by {exact h3,},
exact h4,
}
end

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

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

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

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

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

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

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

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

So $F$ has an infinite model.

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


import Lean

open Lean Meta

def ctor (mvarId : MVarId) (idx : Nat) : MetaM (List MVarId) := do
  /- Set `MetaM` context using `mvarId` -/
  withMVarContext mvarId do
    /- Fail if the metavariable is already assigned. -/
    checkNotAssigned mvarId `ctor
    /- Retrieve the target type, instantiateMVars, and use `whnf`. -/
    let target ← getMVarType' mvarId
    let .const declName us := target.getAppFn
      | throwTacticEx `ctor mvarId "target is not an inductive datatype"
    let .inductInfo { ctors, .. } ← getConstInfo declName
      | throwTacticEx `ctor mvarId "target is not an inductive datatype"
    if idx = 0 then
      throwTacticEx `ctor mvarId "invalid index, it must be > 0"
    else if h : idx - 1 < ctors.length then
      apply mvarId (.const ctors[idx - 1] us)
    else
      throwTacticEx `ctor mvarId "invalid index, inductive datatype has only {ctors.length} contructors"

open Elab Tactic

elab "ctor" idx:num : tactic =>
  liftMetaTactic (ctor · idx.getNat)

example (p : Prop) : p := by
  ctor 1 -- Error

example (h : q) : p ∨ q := by
  ctor 0 -- Error
  exact h

example (h : q) : p ∨ q := by
  ctor 3 -- Error
  exact h

example (h : q) : p ∨ q := by
  ctor 2
  exact h

example (h : q) : p ∨ q := by
  ctor 1
  exact h -- Error


import unitb.decomposition.component

universe variables u

namespace decomposition
section

open predicate unitb function scheduling

parameter {α  : Type}
parameter {t : Type}
parameter [sched t]
parameter {s : t → program α}
parameter {s₀ : α}
parameter (asm : α → α → Prop)
parameter (h₀ : ∀ i, (s i).mch.first s₀)
parameter (h : compatible asm s)
noncomputable def s' := compose s asm h₀ h

parameters {asm h₀ h}

variables {i : t}
variables {p q : pred' α}

lemma local_reasoning.transient
  (T : transient' (s i) p q)
: transient' s' p q :=
begin
  unfold transient' system.transient nondet.program.transient comp,
  unfold transient' system.transient nondet.program.transient comp at T,
  cases T with e Te,
  cases e,
  case some e
  { existsi some (⟨i,e⟩ : Σ i, (s i).mch.lbl),
    apply nondet.program.falsify.mk,
    { apply Te.enable },
    { apply Te.schedule },
    { apply Te.negate' } },
  case none
  { existsi none,
    apply nondet.program.falsify.mk,
    { apply Te.enable },
    { apply Te.schedule },
    { apply Te.negate' } },
end

lemma local_reasoning.unless
  (S : unless (s i) p q)
: unless s' p q :=
begin
  unfold unless,
  intros σ σ' STEP,
  apply S,
  unfold unitb.step has_safety.step step,
  unfold unitb.step has_safety.step step at STEP,
  unfold program.mch program.asm nondet.is_step nondet.program.lbl at STEP,
  unfold program.mch program.asm nondet.is_step nondet.program.lbl,
  cases STEP,
  case or.inl STEP
  { cases STEP with ev STEP,
    cases ev,
    case some ev
    { cases ev with j Hj,
      cases classical.em (i = j) with Heq Hne,
      { subst j,
        left, existsi some Hj,
        apply STEP },
      { right, apply h.step _ _ Hne,
        unfold nondet.is_step,
        existsi some Hj,
        apply STEP, }, },
    case none
    { left, existsi none, apply STEP } },
  case or.inr STEP
  { right, apply h.asm, apply STEP, },
end

theorem leads_to.subst {p q}
  (H : p ↦ q in s i)
: p ↦ q in s' :=
unitb.leads_to.subst id _ _
(@local_reasoning.transient i) (@local_reasoning.unless i) H

theorem often_imp_often.subst {p q}
  (H : p >~> q in s i)
: p >~> q in s' :=
unitb.often_imp_often.subst id _ _
(@local_reasoning.transient i) (@local_reasoning.unless i) H

end
end decomposition


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.coprime p x) : nat.units (p_adic_int p) x :=
begin
  have h1 : nat.units (p_adic_int p) x ↔ (p_adic_int p).norm x = 1, from by auto [units_iff_norm_eq_one],
  have h2 : (p_adic_int p).norm x < 1, from by auto [h, p_adic_int.norm_eq_zero_iff, p_adic_int.norm_eq_one_iff, p_adic_int.norm_eq_p_iff, p_adic_int.norm_eq_p_pow_iff],
  have h3 : p ∣ x, from by auto [h2, p_adic_int.norm_eq_zero_iff, p_adic_int.norm_eq_one_iff, p_adic_int.norm_eq_p_iff, p_adic_int.norm_eq_p_pow_iff],
  have h4 : ¬ nat.coprime p x, from by auto [h3, nat.coprime_iff_prime_dvd],
  show ¬ nat.units (p_adic_int p) x, from by auto [h1, h2, units_iff_norm_eq_one],
end

--OUTPUT 2
theorem p_adic_units (p : ℕ) (x : ℕ) (h : gcd x p = 1) : ∃ y : ℕ, x * y = 1 :=
begin
  have h1 : ∀ x : ℕ, ∃ y : ℕ, x * y = 1, from by auto using [use (x⁻¹)],
  have h2 : ∀ x : ℕ, ∃ y : ℕ, y * x = 1, from by auto using [use (x⁻¹)],
  have h3 : ∃ y : ℕ, x * y = 1, from by auto [h1],
  have h4 : ∃ y : ℕ, y * x = 1, from by auto [h2],
  show ∃ y : ℕ, x * y = 1, from by auto [h3, h4, exists_unique.unique, exists_unique.exists] using [use (x⁻¹)],
end

--OUTPUT 3
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.coprime x p) : ∃ y : ℤ, x * y = 1 :=
begin
  have h1 : ¬ (∃ y : ℤ, x * y = 1), from by auto [nat.not_coprime_iff_dvd],
  have h2 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h1],
  have h3 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h2],
  have h4 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h3],
  have h5 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h4],
  have h6 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h5],
  have h7 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h6],
  have h8 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h7],
  have h9 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h8],
  have h10 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h9],
  have h11 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h10],
  have h12 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h11],
  have h13 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h12],
  have h14 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h13],
  have h15 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h14],
  have h16 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h15],
  have h17 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h16],
  have h18 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h17],
  have h19 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h18],
  have h20 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h19],
  have h21 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h20],
  have h22 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h21],
  have h23 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h22],
  have h24 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h23],
  have h25 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h24],
  have h26 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h25],
  have h27 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h26],
  have h28 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h27],
  have h29 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h28],
  have h30 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h29],
  have h31 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h30],
  have h32 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h31],
  have h33 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h32],
  have h34 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h33],
  have h35 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h34],
  have h36 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h35],
  have h37 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h36],
  have h38 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h37],
  have h39 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h38],
  have h40 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h39],
  have h41 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h40],
  have h42 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h41],
  have h43 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h42],
  have h44 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h43],
  have h45 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h44],
  have h46 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h45],
  have h47 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h46],
  have h48 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h47],
  have h49 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h48],
  have h50 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h49],
  have h51 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h50],
  have h52 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h51],
  have h53 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h52],
  have h54 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h53],
  have h55 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h54],
  have h56 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h55],
  have h57 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h56],
  have h58 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h57],
  have h59 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h58],
  have h60 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h59],
  have h61 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h60],
  have h62 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h61],
  have h63 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h62],
  have h64 : ¬ (∃ y : ℤ, x * y = 1), from by auto [h63],
  have h65 : ¬ (∃ y : ℤ, x * y = 1),
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`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import ..syntax_directed
import ..type_system
import .structural_subtyping

namespace flow_analysis

lemma syntax_directed_subtyping.expr {Λ : location} {γ : identifier} {e : base_expr}
    {ρ ρ' : phrase} :
  ((Λ, γ) ⊢ₛₑ e : ρ ∧ ρ ⊆ₛ ρ') → ((Λ, γ) ⊢ₛₑ e : ρ')
:= begin
  intro h,
  cases h with h_ctx h_sub,
  induction h_ctx,
  case syntax_directed.expr_typing.int : n _ {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with x h_lemma4,
    cases h_lemma4 with y h_lemma4,
    cases h_lemma4,
    have h2 := h_lemma4.right.left,
    rw h2,
    apply syntax_directed.expr_typing.int,
    cc,
  },
  case syntax_directed.expr_typing.var : Λ γ v x ih {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with a h_lemma4,
    cases h_lemma4 with b h_lemma4,
    cases h_lemma4,
    cc,
    repeat { cases h_lemma4, },
    rw eq.symm h_lemma4_right,
    apply syntax_directed.expr_typing.var ih,
    cc,
  },
  case syntax_directed.expr_typing.varloc : Λ γ v x ih {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with a h_lemma4,
    cases h_lemma4 with b h_lemma4,
    cases h_lemma4,
    cc,
    repeat { cases h_lemma4, },
    rw eq.symm h_lemma4_right,
    apply syntax_directed.expr_typing.varloc ih,
    cc,
  },
  case syntax_directed.expr_typing.binop : Λ γ a b z τ iha ihb ihsuba ihsubb {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with x h_lemma4,
    cases h_lemma4 with y h_lemma4,
    cases h_lemma4,
    have h := h_lemma4.right.left,
    simp[h] at *,
    apply syntax_directed.expr_typing.binop (ihsuba h_sub) (ihsubb h_sub),
    cc,
  },
  case syntax_directed.expr_typing.r_val : Λ γ e τ τ' he hxy ih {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with x h_lemma4,
    cases h_lemma4 with y h_lemma4,
    cases h_lemma4,
    cases h_lemma4 with h1 h_lemma4,
    cases h_lemma4 with h2 h3,
    simp at h1,
    simp[h1, h2] at *,
    have h := le_trans hxy h3,
    apply syntax_directed.expr_typing.r_val he h,
    cc,
  },
end

/- Lemma 6.1
 - If (Λ, γ) ⊢ₛ p : ρ and ⊢ ρ ⊆ₛ ρ', then (Λ, γ) ⊢ₛ p : ρ'
 -/
lemma syntax_directed_subtyping {Λ : location} {γ : identifier} {p : program}
    {ρ ρ' : phrase} :
  ((Λ, γ) ⊢ₛ p : ρ ∧ ρ ⊆ₛ ρ') → ((Λ, γ) ⊢ₛ p : ρ')
:= begin
  intro h,
  cases h with h_ctx h_sub,
  induction h_ctx,
  case syntax_directed.program_typing.assign_var : Λ γ v e τ τ' ihv ihe ihyx {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with x h_lemma4,
    cases h_lemma4 with y h_lemma4,
    repeat { cases h_lemma4, cc, },
    cases h_lemma4 with h1 h_lemma4,
    cases h_lemma4 with h2 h3,
    simp at h1,
    simp[h1, h2] at *,
    have h := le_trans h3 ihyx,
    apply syntax_directed.program_typing.assign_var ihv ihe h,
  },
  case syntax_directed.program_typing.assign_loc : Λ γ v e τ τ' ihv ihe ihyx {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with x h_lemma4,
    cases h_lemma4 with y h_lemma4,
    repeat { cases h_lemma4, cc, },
    cases h_lemma4 with h1 h_lemma4,
    cases h_lemma4 with h2 h3,
    simp at h1,
    simp[h1, h2] at *,
    have h := le_trans h3 ihyx,
    apply syntax_directed.program_typing.assign_loc ihv ihe h,
  },
  case syntax_directed.program_typing.compose : Λ γ c c' τ hc hc' ihc ihc' {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with x h_lemma4,
    cases h_lemma4 with y h_lemma4,
    repeat { cases h_lemma4, cc, },
    have h := h_lemma4.right.left,
    simp[h] at *,
    apply syntax_directed.program_typing.compose (ihc h_sub) (ihc' h_sub),
  },
  case syntax_directed.program_typing.branch
    : Λ γ e c c' τ τ' he hc hc' ihc ihc' ih {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with x h_lemma4,
    cases h_lemma4 with y h_lemma4,
    repeat { cases h_lemma4, cc, },
    cases h_lemma4 with h1 h_lemma4,
    cases h_lemma4 with h2 h3,
    simp at h1,
    simp[h1, h2] at *,
    have h := le_trans h3 ihc,
    apply syntax_directed.program_typing.branch he hc hc' h,
  },
  case syntax_directed.program_typing.while : Λ γ e c τ τ' he hc hττ' ihc {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with x h_lemma4,
    cases h_lemma4 with y h_lemma4,
    repeat { cases h_lemma4, cc, },
    cases h_lemma4 with h1 h_lemma4,
    cases h_lemma4 with h2 h3,
    simp at h1,
    simp[h1, h2] at *,
    have h := le_trans h3 hττ',
    apply syntax_directed.program_typing.while he hc h,
  },
  case syntax_directed.program_typing.letvar : Λ γ x e c τ τ' he hc ih {
    have h_lemma4 := structural_subtyping h_sub,
    cases h_lemma4 with x h_lemma4,
    cases h_lemma4 with y h_lemma4,
    repeat { cases h_lemma4, cc, },
    cases h_lemma4 with h1 h_lemma4,
    cases h_lemma4 with h2 h3,
    simp at h1,
    simp[h1, h2] at *,
    apply syntax_directed.program_typing.letvar he (ih h_sub),
  },
end

lemma program_typing_eq.expr {Λ : location} {γ : identifier} {e : base_expr}
  {ρ : phrase} : ((Λ, γ) ⊢ₑ e : ρ) ↔ ((Λ, γ) ⊢ₛₑ e : ρ)
:= begin
  apply iff.intro,
  { intro h,
    induction h,
    { exact syntax_directed.expr_typing.int, },
    { rename h_h h,
      exact syntax_directed.expr_typing.var h, },
    { rename h_h h,
      exact syntax_directed.expr_typing.varloc h, },
    { rename h_ih_a ha, rename h_ih_a_1 hb,
      exact syntax_directed.expr_typing.binop ha hb, },
    case type_system.expr_typing.r_val : Λ γ e τ he ihe {
      exact syntax_directed.expr_typing.r_val ihe (le_refl τ), },
    case type_system.expr_typing.subtype : Λ γ p ρ ρ' hp hρρ' ih {
      exact syntax_directed_subtyping.expr (and.intro ih hρρ'),
    },
  },
  { intro h,
    induction h,
    { exact type_system.expr_typing.int, },
    { rename h_h h,
      exact type_system.expr_typing.var h, },
    { rename h_h h,
      exact type_system.expr_typing.varloc h, },
    { rename h_ih_a ha, rename h_ih_a_1 hb,
      exact type_system.expr_typing.binop ha hb, },
    case syntax_directed.expr_typing.r_val : Λ γ e τ τ' he hττ' ih {
      have h := phrase.ss.base hττ',
      have h_rval := type_system.expr_typing.r_val ih,
      exact type_system.expr_typing.subtype h_rval h, },
  },
end

/- Theorem 6.2
 - (Λ, γ) ⊢ₜ p : ρ ↔ (Λ, γ) ⊢ₛ p : ρ -/
theorem program_typing_eq {Λ : location} {γ : identifier}
  {p : program} {ρ : phrase} : ((Λ, γ) ⊢ₜ p : ρ) ↔ ((Λ, γ) ⊢ₛ p : ρ)
:= begin
  apply iff.intro,
  { intro h,
    induction h,
    case type_system.program_typing.assign_var : Λ γ e e' τ he he' {
      have ha := program_typing_eq.expr.1 he,
      have hb := program_typing_eq.expr.1 he',
      exact syntax_directed.program_typing.assign_var ha hb (le_refl τ),
    },
    case type_system.program_typing.assign_loc : Λ γ e e' τ he he' {
      have ha := program_typing_eq.expr.1 he,
      have hb := program_typing_eq.expr.1 he',
      exact syntax_directed.program_typing.assign_loc ha hb (le_refl τ),
    },
    case type_system.program_typing.compose : Λ γ c c' τ hc hc' ihc ihc' {
      exact syntax_directed.program_typing.compose ihc ihc',
    },
    case type_system.program_typing.branch : Λ γ e c c' τ he hc hc' ihc ihc' {
      have ihe := program_typing_eq.expr.1 he,
      exact syntax_directed.program_typing.branch ihe ihc ihc' (le_refl τ),
    },
    case type_system.program_typing.while : Λ γ e c τ he hc ihc {
      have ihe := program_typing_eq.expr.1 he,
      exact syntax_directed.program_typing.while ihe ihc (le_refl τ),
    },
    case type_system.program_typing.letvar : Λ γ x e c τ τ' he hc ihc {
      have ihe := program_typing_eq.expr.1 he,
      exact syntax_directed.program_typing.letvar ihe ihc,
    },
    case type_system.program_typing.subtype : Λ γ p ρ ρ' hp hρρ' ihp {
      exact syntax_directed_subtyping (and.intro ihp hρρ'),
    },
  },
  { intro h,
    induction h,
    case syntax_directed.program_typing.assign_var : Λ γ e e' τ τ' he he' hττ' {
      have ha := program_typing_eq.expr.2 he,
      have hb := program_typing_eq.expr.2 he',
      have h_cmd := (phrase.ss.cmd (phrase.ss.base hττ')),
      have h_assign := type_system.program_typing.assign_var ha hb,
      exact type_system.program_typing.subtype h_assign h_cmd,
    },
    case syntax_directed.program_typing.assign_loc : Λ γ e e' τ τ' he he' hττ' {
      have ha := program_typing_eq.expr.2 he,
      have hb := program_typing_eq.expr.2 he',
      have h_cmd := (phrase.ss.cmd (phrase.ss.base hττ')),
      have h_assign := type_system.program_typing.assign_loc ha hb,
      exact type_system.program_typing.subtype h_assign h_cmd,
    },
    case syntax_directed.program_typing.compose : Λ γ c c' τ hc hc' ihc ihc' {
      exact type_system.program_typing.compose ihc ihc',
    },
    case syntax_directed.program_typing.branch
        : Λ γ e c c' τ τ' he hc hc' hτ'τ ihc ihc' {
      have ihe := program_typing_eq.expr.2 he,
      have h_sub := phrase.ss.cmd (phrase.ss.base hτ'τ),
      have h_ctx := type_system.program_typing.branch ihe ihc ihc',
      exact type_system.program_typing.subtype h_ctx h_sub,
    },
    case syntax_directed.program_typing.while : Λ γ e c τ τ' he hc hττ' ihc {
      have ihe := program_typing_eq.expr.2 he,
      have h_sub := phrase.ss.cmd (phrase.ss.base hττ'),
      have h_ctx := type_system.program_typing.while ihe ihc,
      exact type_system.program_typing.subtype h_ctx h_sub,
    },
    case syntax_directed.program_typing.letvar
        : Λ γ x e c τ τ' he hc ihc {
      have ihe := program_typing_eq.expr.2 he,
      exact type_system.program_typing.letvar ihe ihc,
    },
  },
end
end flow_analysis


inductive Fam : Type → Type 1 where
  | any : Fam α
  | nat : Nat → Fam Nat

example (a : α) : Fam α → α
  | Fam.any => a
  | Fam.nat n => n

inductive Fam2 : Type → Type → Type 1 where
  | any : Fam2 α α
  | nat : Nat → Fam2 Nat Nat

example (a : α) : Fam2 α β → β
  | Fam2.any   => a
  | Fam2.nat n => n


import breen_deligne.eval2
import condensed.tensor
import condensed.evaluation_homology
import condensed.sheafification_homology
import for_mathlib.AddCommGroup
import for_mathlib.map_to_sheaf_is_iso
import condensed.is_iso_iff_extrdisc
import condensed.ab5
import condensed.ab4
import for_mathlib.endomorphisms.ab4
import for_mathlib.homology_exact
import for_mathlib.free_abelian_group2
import for_mathlib.embed_preserves_colimits

.

noncomputable theory

universes u

open category_theory category_theory.limits breen_deligne opposite
open bounded_homotopy_category

abbreviation freeCond' := Condensed_Ab_to_CondensedSet ⋙ CondensedSet_to_Condensed_Ab

namespace Condensed

variables (BD : package)

abbreviation freeFunc : (Profiniteᵒᵖ ⥤ Ab) ⥤ Profiniteᵒᵖ ⥤ Ab :=
(whiskering_right _ _ _).obj (forget _ ⋙ AddCommGroup.free)

namespace eval_freeCond'_iso

def component_zero (M : Condensed.{u} Ab.{u+1}) :
  ((BD.eval' freeCond').obj M).X (int.of_nat 0) ≅
  ((presheaf_to_Condensed_Ab.map_homological_complex (complex_shape.up ℤ)).obj
    ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).X
  (int.of_nat 0) :=
presheaf_to_Condensed_Ab.map_iso begin
    refine functor.associator _ _ _ ≪≫ _,
    refine iso_whisker_right _ _,
    refine (Condensed_Ab_to_presheaf.map_biproduct _),
  end

def component_pos (M : Condensed.{u} Ab.{u+1}) (i : ℕ) :
  ((BD.eval' freeCond').obj M).X (int.of_nat (i+1)) ≅
  ((presheaf_to_Condensed_Ab.map_homological_complex (complex_shape.up ℤ)).obj
    ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).X
  (int.of_nat (i+1)) :=
is_zero.iso (is_zero_zero _) (functor.map_is_zero _ $ is_zero_zero _)

def component_neg (M : Condensed.{u} Ab.{u+1}) (i : ℕ) :
  ((BD.eval' freeCond').obj M).X (-[1+i]) ≅
  ((presheaf_to_Condensed_Ab.map_homological_complex (complex_shape.up ℤ)).obj
    ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).X
  (-[1+i]) :=
presheaf_to_Condensed_Ab.map_iso begin
    refine functor.associator _ _ _ ≪≫ _,
    refine iso_whisker_right _ _,
    refine (Condensed_Ab_to_presheaf.map_biproduct _),
  end

end eval_freeCond'_iso

open_locale big_operators
open category_theory.preadditive

lemma eval_freeCond'_iso_component_aux₀ (M : Condensed.{u} Ab.{u+1}) :
  (eval_freeCond'_iso.component_neg BD M 0).hom ≫
    ((presheaf_to_Condensed_Ab.map_homological_complex (complex_shape.up ℤ)).obj
       ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).d
      -[1+ 0] (int.of_nat 0) =
  ((BD.eval' freeCond').obj M).d -[1+ 0] (int.of_nat 0) ≫
  (eval_freeCond'_iso.component_zero BD M).hom :=
begin
  dsimp [eval_freeCond'_iso.component_neg, eval_freeCond'_iso.component_zero, package.eval',
    homological_complex.embed, homological_complex.embed.obj],
  erw homological_complex.embed.d_some_some,
  erw homological_complex.embed.d_some_some,
  dsimp [data.eval_functor', universal_map.eval_Pow],
  simp_rw free_abelian_group.lift_eq_sum,
  simp only [nat_trans.app_sum, nat_trans.app_zsmul],
  --dsimp,
  rw [functor.map_sum, sum_comp, comp_sum],
  refine finset.sum_congr rfl _, rintro x -,
  rw [functor.map_zsmul, zsmul_comp, comp_zsmul],
  refine congr_arg2 _ rfl _,
  dsimp,
  rw ← presheaf_to_Condensed_Ab.map_comp,
  erw ← presheaf_to_Condensed_Ab.map_comp,
  congr' 1,
  ext t : 2, dsimp only [nat_trans.comp_app, whisker_right_app, functor.associator],
  simp only [category.id_comp, category.comp_id],
  simp only [← functor.map_comp],
  congr' 1, simp only [← nat_trans.comp_app], congr' 1,
  apply biproduct.hom_ext, intros j,
  simp only [category.assoc, biproduct.matrix_π, biproduct.lift_π],
  dsimp only [functor.map_bicone],
  rw biproduct.lift_desc,
  erw [← Condensed_Ab_to_presheaf.map_comp, biproduct.matrix_π],
  simp_rw [comp_zsmul, category.comp_id, ← functor.map_zsmul, ← functor.map_sum],
  congr' 1,
  apply biproduct.hom_ext', intros k,
  rw [biproduct.ι_desc, comp_sum],
  rw finset.sum_eq_single_of_mem k (finset.mem_univ _),
  { simp },
  { rintros b - hb, dsimp, rw comp_zsmul, rw biproduct.ι_π,
    rw [dif_neg hb.symm, zsmul_zero] }
end

lemma eval_freeCond'_iso_component_aux_i (M : Condensed.{u} Ab.{u+1}) (i : ℕ) :
(eval_freeCond'_iso.component_neg BD M (i+1)).hom ≫
    ((presheaf_to_Condensed_Ab.map_homological_complex (complex_shape.up ℤ)).obj
       ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).d
      -[1+ (i+1)] -[1+ i] =
  ((BD.eval' freeCond').obj M).d -[1+ (i+1)] -[1+ i] ≫
  (eval_freeCond'_iso.component_neg BD M i).hom :=
begin
  dsimp [eval_freeCond'_iso.component_neg, eval_freeCond'_iso.component_zero, package.eval',
    homological_complex.embed, homological_complex.embed.obj],
  erw homological_complex.embed.d_some_some,
  erw homological_complex.embed.d_some_some,
  dsimp [data.eval_functor', universal_map.eval_Pow],
  simp_rw free_abelian_group.lift_eq_sum,
  simp only [nat_trans.app_sum, nat_trans.app_zsmul],
  --dsimp,
  rw [functor.map_sum, sum_comp, comp_sum],
  refine finset.sum_congr rfl _, rintro x -,
  rw [functor.map_zsmul, zsmul_comp, comp_zsmul],
  refine congr_arg2 _ rfl _,
  dsimp,
  rw ← presheaf_to_Condensed_Ab.map_comp,
  erw ← presheaf_to_Condensed_Ab.map_comp,
  congr' 1,
  ext t : 2, dsimp only [nat_trans.comp_app, whisker_right_app, functor.associator],
  simp only [category.id_comp, category.comp_id],
  simp only [← functor.map_comp],
  congr' 1, simp only [← nat_trans.comp_app], congr' 1,
  apply biproduct.hom_ext, intros j,
  simp only [category.assoc, biproduct.matrix_π, biproduct.lift_π],
  dsimp only [functor.map_bicone],
  rw biproduct.lift_desc,
  erw [← Condensed_Ab_to_presheaf.map_comp, biproduct.matrix_π],
  simp_rw [comp_zsmul, category.comp_id, ← functor.map_zsmul, ← functor.map_sum],
  congr' 1,
  apply biproduct.hom_ext', intros k,
  rw [biproduct.ι_desc, comp_sum],
  rw finset.sum_eq_single_of_mem k (finset.mem_univ _),
  { simp },
  { rintros b - hb, dsimp, rw comp_zsmul, rw biproduct.ι_π,
    rw [dif_neg hb.symm, zsmul_zero] }
end

def eval_freeCond'_iso_component (M : Condensed.{u} Ab.{u+1}) :
  ((BD.eval' freeCond').obj M) ≅
  (presheaf_to_Condensed_Ab.map_homological_complex _).obj
  ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M)) :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| int.of_nat 0 := eval_freeCond'_iso.component_zero _ _
| int.of_nat (i+1) := eval_freeCond'_iso.component_pos _ _ _
| -[1+i] := eval_freeCond'_iso.component_neg _ _ _
end )
begin
  rintros ((_|i)|(_|i)) ((_|j)|(_|j)) ⟨rfl⟩,
  { apply is_zero.eq_of_tgt,
    apply functor.map_is_zero,
    apply is_zero_zero },
  { apply is_zero.eq_of_tgt,
    apply functor.map_is_zero,
    apply is_zero_zero },
  { apply eval_freeCond'_iso_component_aux₀ },
  { apply eval_freeCond'_iso_component_aux_i },
  { apply eval_freeCond'_iso_component_aux_i },
end
.

lemma eval_freeCond'_iso_component_hom_zero (M : Condensed.{u} Ab.{u+1}) :
  (eval_freeCond'_iso_component BD M).hom.f 0 =
  begin
    refine presheaf_to_Condensed_Ab.map _,
    refine _ ≫ (functor.associator _ _ _).hom,
    refine whisker_right _ _,
    refine whisker_right _ _,
    refine (Condensed_Ab_to_presheaf.map_biproduct _).hom,
  end := rfl

lemma eval_freeCond'_iso_component_hom_neg (M : Condensed.{u} Ab.{u+1}) (i : ℕ) :
  (eval_freeCond'_iso_component BD M).hom.f (-[1+i]) =
  begin
    refine presheaf_to_Condensed_Ab.map _,
    refine _ ≫ (functor.associator _ _ _).hom,
    refine whisker_right _ _,
    refine whisker_right _ _,
    refine (Condensed_Ab_to_presheaf.map_biproduct _).hom,
  end := rfl

namespace eval_freeAb_iso

def component_zero (M : Condensed.{u} Ab.{u+1}) (S : ExtrDisc.{u}) :
  ((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
  (op S.val)).map_homological_complex (complex_shape.up ℤ)).obj
  ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).X (int.of_nat 0) ≅
  ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).obj (M.val.obj (op S.val))).X
  (int.of_nat 0) :=
begin
  refine AddCommGroup.free.map_iso _,
  refine (category_theory.forget _).map_iso _,
  refine ((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op S.val)).map_biproduct _
end

def component_pos (M : Condensed.{u} Ab.{u+1}) (S : ExtrDisc.{u}) (i : ℕ) :
  ((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
    (op S.val)).map_homological_complex (complex_shape.up ℤ)).obj
    ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).X
    (int.of_nat (i + 1)) ≅
  ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).obj
  (M.val.obj (op S.val))).X (int.of_nat (i + 1)) :=
is_zero.iso (functor.map_is_zero _ $ is_zero_zero _) (is_zero_zero _)

def component_neg (M : Condensed.{u} Ab.{u+1}) (S : ExtrDisc.{u}) (i : ℕ) :
  ((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op S.val)).map_homological_complex
    (complex_shape.up ℤ)).obj
    ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).X -[1+ i] ≅
  ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).obj (M.val.obj (op S.val))).X -[1+ i] :=
begin
  refine AddCommGroup.free.map_iso _,
  refine (category_theory.forget _).map_iso _,
  refine ((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op S.val)).map_biproduct _
end

end eval_freeAb_iso

local attribute [-simp] forget_map_eq_coe

lemma eval_freeAb_iso_component_aux₀ (M : Condensed.{u} Ab.{u+1}) (S : ExtrDisc.{u}) :
  (eval_freeAb_iso.component_neg BD M S 0).hom ≫
    ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).obj (M.val.obj (op S.val))).d
      -[1+ 0] (int.of_nat 0) =
  ((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op S.val)).map_homological_complex
    (complex_shape.up ℤ)).obj
      ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).d -[1+ 0] (int.of_nat 0) ≫
  (eval_freeAb_iso.component_zero BD M S).hom :=
begin
  dsimp only [eval_freeAb_iso.component_neg, eval_freeAb_iso.component_zero, functor.map_iso,
    package.eval', data.eval_functor', functor.map_homological_complex,
    category_theory.evaluation, functor.comp_obj, homological_complex.embed,
    homological_complex.embed.obj],
  erw homological_complex.embed.d_some_some,
  erw homological_complex.embed.d_some_some,
  dsimp only [data.eval_functor, data.eval_functor', functor.comp_obj, functor.flip,
    homological_complex.functor_eval, homological_complex.functor_eval.obj,
    category_theory.evaluation, functor.map_homological_complex,
    universal_map.eval_Pow_functor, universal_map.eval_Pow, functor.map_biproduct],
  simp only [free_abelian_group.lift_eq_sum, sum_comp, comp_sum, nat_trans.app_sum],
  apply finset.sum_congr rfl, rintro x -,
  simp only [nat_trans.app_zsmul],
  dsimp [functor.map_bicone],
  simp only [zsmul_comp, comp_zsmul, ← functor.map_comp], congr' 3,
  apply biproduct.hom_ext, intros j,
  simp only [category.assoc, biproduct.lift_π, biproduct.matrix_π, biproduct.lift_desc],
  erw biproduct.lift_π,
  rw [← nat_trans.comp_app, biproduct.matrix_π],
  simp_rw [← nat_trans.id_app, ← nat_trans.app_zsmul, ← nat_trans.comp_app,
    ← nat_trans.app_sum], congr' 1,
  apply biproduct.hom_ext', intro k, simp only [comp_sum, biproduct.ι_desc],
  rw [finset.sum_eq_single_of_mem k (finset.mem_univ _),
  biproduct.ι_π_assoc, dif_pos rfl],
  { simpa, },
  { rintros b - hb, rw [biproduct.ι_π_assoc, dif_neg hb.symm, zero_comp] }
end

lemma eval_freeAb_iso_component_aux (M : Condensed.{u} Ab.{u+1}) (S : ExtrDisc.{u}) (i : ℕ) :
  (eval_freeAb_iso.component_neg BD M S (i+1)).hom ≫
    ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).obj
    (M.val.obj (op S.val))).d -[1+ (i+1)] -[1+ i] =
  ((((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
    (op S.val)).map_homological_complex (complex_shape.up ℤ)).obj
       ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))).d -[1+ (i+1)] -[1+ i] ≫
    (eval_freeAb_iso.component_neg BD M S i).hom :=
begin
  dsimp only [eval_freeAb_iso.component_neg, eval_freeAb_iso.component_zero, functor.map_iso,
    package.eval', data.eval_functor', functor.map_homological_complex,
    category_theory.evaluation, functor.comp_obj, homological_complex.embed,
    homological_complex.embed.obj],
  erw homological_complex.embed.d_some_some,
  erw homological_complex.embed.d_some_some,
  dsimp only [data.eval_functor, data.eval_functor', functor.comp_obj, functor.flip,
    homological_complex.functor_eval, homological_complex.functor_eval.obj,
    category_theory.evaluation, functor.map_homological_complex,
    universal_map.eval_Pow_functor, universal_map.eval_Pow, functor.map_biproduct],
  simp only [free_abelian_group.lift_eq_sum, sum_comp, comp_sum, nat_trans.app_sum],
  apply finset.sum_congr rfl, rintro x -,
  simp only [nat_trans.app_zsmul],
  dsimp [functor.map_bicone],
  simp only [zsmul_comp, comp_zsmul, ← functor.map_comp], congr' 3,
  apply biproduct.hom_ext, intros j,
  simp only [category.assoc, biproduct.lift_π, biproduct.matrix_π, biproduct.lift_desc],
  erw biproduct.lift_π,
  rw [← nat_trans.comp_app, biproduct.matrix_π],
  simp_rw [← nat_trans.id_app, ← nat_trans.app_zsmul, ← nat_trans.comp_app,
    ← nat_trans.app_sum], congr' 1,
  apply biproduct.hom_ext', intro k, simp only [comp_sum, biproduct.ι_desc],
  rw [finset.sum_eq_single_of_mem k (finset.mem_univ _),
  biproduct.ι_π_assoc, dif_pos rfl],
  { simpa, },
  { rintros b - hb, rw [biproduct.ι_π_assoc, dif_neg hb.symm, zero_comp] }
end

def eval_freeAb_iso_component (M : Condensed.{u} Ab.{u+1}) (S : ExtrDisc.{u}) :
  (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj (op S.val)).map_homological_complex
    (complex_shape.up ℤ)).obj
  ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M)) ≅
  (BD.eval' $ category_theory.forget _ ⋙ AddCommGroup.free).obj (M.val.obj (op S.val)) :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| int.of_nat 0 :=  eval_freeAb_iso.component_zero _ _ _
| int.of_nat (i+1) := eval_freeAb_iso.component_pos _ _ _ _
| -[1+i] := eval_freeAb_iso.component_neg _ _ _ _
end )
begin
  rintros ((_|i)|(_|i)) ((_|j)|(_|j)) ⟨rfl⟩,
  { apply is_zero.eq_of_tgt,
    apply is_zero_zero },
  { apply is_zero.eq_of_tgt,
    apply is_zero_zero },
  { apply eval_freeAb_iso_component_aux₀ },
  { apply eval_freeAb_iso_component_aux },
  { apply eval_freeAb_iso_component_aux },
end
.

@[simp]
lemma eval_freeAb_iso_component_zero (M : Condensed.{u} Ab.{u+1}) (S : ExtrDisc.{u}) :
  (eval_freeAb_iso_component BD M S).hom.f 0 =
  (eval_freeAb_iso.component_zero BD M S).hom := rfl

@[simp]
lemma eval_freeAb_iso_component_neg (M : Condensed.{u} Ab.{u+1}) (S : ExtrDisc.{u}) (i : ℕ) :
  (eval_freeAb_iso_component BD M S).hom.f (-[1+i]) =
  (eval_freeAb_iso.component_neg BD M S i).hom := rfl

lemma eval_freeCond'_iso_aux_zero
  (X Y : Condensed Ab) (f : X ⟶ Y) :
  ((BD.eval' freeCond').map f ≫ (eval_freeCond'_iso_component BD Y).hom).f (int.of_nat 0) =
  ((eval_freeCond'_iso_component BD X).hom ≫
     (Condensed_Ab_to_presheaf ⋙
        BD.eval' freeFunc ⋙ presheaf_to_Condensed_Ab.map_homological_complex
        (complex_shape.up ℤ)).map f).f (int.of_nat 0) :=
begin
  dsimp only [
    homological_complex.hom.iso_of_components,
    homological_complex.comp_f, package.eval', data.eval_functor', data.eval_functor,
    functor.comp_map, int.of_nat_zero,
    homological_complex.embed_nat_obj_down_up_zero_f,
    homological_complex.comp_f, functor.map_homological_complex_map_f,
    functor.comp_obj, functor.flip,
    homological_complex.functor_eval, universal_map.eval_Pow_functor,
    functor.map_homological_complex],
  rw eval_freeCond'_iso_component_hom_zero,
  rw eval_freeCond'_iso_component_hom_zero,
  dsimp,
  rw ← presheaf_to_Condensed_Ab.map_comp,
  erw ← presheaf_to_Condensed_Ab.map_comp,
  congr' 1, -- we got rid of the sheafification :)
  ext t : 2,
  dsimp,
  simp only [category.id_comp, category.comp_id, ← functor.map_comp],
  congr' 2,
  simp_rw ← nat_trans.comp_app, congr' 1,
  dsimp [functor.map_bicone],
  apply biproduct.hom_ext, intros j,
  simp only [category.assoc, biproduct.map_π, biproduct.lift_π_assoc, biproduct.lift_π],
  erw [← Condensed_Ab_to_presheaf.map_comp, ← Condensed_Ab_to_presheaf.map_comp,
    biproduct.map_π],
end

.

lemma eval_freeAb_iso_component_naturality (M : Condensed.{u} Ab.{u+1}) (S T : ExtrDisc.{u})
  (f : S ⟶ T) :
  (eval_freeAb_iso_component BD M T).hom ≫
  (BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).map
    (M.val.map (ExtrDisc_to_Profinite.map f).op) =
  (nat_trans.map_homological_complex ((category_theory.evaluation Profiniteᵒᵖ Ab).map f.val.op)
  (complex_shape.up ℤ)).app ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))
    ≫ (eval_freeAb_iso_component BD M S).hom :=
begin
  ext ((_|i)|i) : 2,
  { change AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) ≫ AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) =
      AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) ≫ AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _),
    simp only [← functor.map_comp], congr' 2,
    apply biproduct.hom_ext, rintro ⟨j⟩,
    dsimp [functor.map_bicone],
    simp only [category.assoc],
    erw biproduct.lift_π,
    erw biproduct.map_π,
    erw biproduct.lift_π_assoc,
    simp only [nat_trans.naturality],
    refl },
  { apply is_zero.eq_of_tgt,
    apply is_zero_zero },
  { change AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) ≫ AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) =
      AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) ≫ AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _),
    simp only [← functor.map_comp], congr' 2,
    apply biproduct.hom_ext, rintro ⟨j⟩,
    dsimp [functor.map_bicone],
    simp only [category.assoc],
    erw biproduct.lift_π,
    erw biproduct.map_π,
    erw biproduct.lift_π_assoc,
    simp only [nat_trans.naturality],
    refl },
end

lemma eval_freeCond'_iso_aux_neg
  (X Y : Condensed Ab) (f : X ⟶ Y) (i : ℕ) :
  ((BD.eval' freeCond').map f ≫ (eval_freeCond'_iso_component BD Y).hom).f (-[1+i]) =
  ((eval_freeCond'_iso_component BD X).hom ≫
     (Condensed_Ab_to_presheaf ⋙
        BD.eval' freeFunc ⋙ presheaf_to_Condensed_Ab.map_homological_complex
        (complex_shape.up ℤ)).map f).f (-[1+i]) :=
begin
  dsimp only [
    homological_complex.hom.iso_of_components,
    homological_complex.comp_f, package.eval', data.eval_functor', data.eval_functor,
    functor.comp_map, int.of_nat_zero,
    homological_complex.embed_nat_obj_down_up_zero_f,
    homological_complex.comp_f, functor.map_homological_complex_map_f,
    functor.comp_obj, functor.flip,
    homological_complex.functor_eval, universal_map.eval_Pow_functor,
    functor.map_homological_complex],
  rw eval_freeCond'_iso_component_hom_neg,
  rw eval_freeCond'_iso_component_hom_neg,
  dsimp,
  rw ← presheaf_to_Condensed_Ab.map_comp,
  erw ← presheaf_to_Condensed_Ab.map_comp,
  congr' 1, -- we got rid of the sheafification :)
  ext t : 2,
  dsimp,
  simp only [category.id_comp, category.comp_id, ← functor.map_comp],
  congr' 2,
  simp_rw ← nat_trans.comp_app, congr' 1,
  dsimp [functor.map_bicone],
  apply biproduct.hom_ext, intros j,
  simp only [category.assoc, biproduct.map_π, biproduct.lift_π_assoc, biproduct.lift_π],
  erw [← Condensed_Ab_to_presheaf.map_comp, ← Condensed_Ab_to_presheaf.map_comp,
    biproduct.map_π],
end

def eval_freeCond'_iso :
  BD.eval' freeCond' ≅
  Condensed_Ab_to_presheaf ⋙ BD.eval' freeFunc ⋙ presheaf_to_Condensed_Ab.map_homological_complex _ :=
nat_iso.of_components
(λ M, eval_freeCond'_iso_component _ _)
begin
  intros X Y f,
  ext ((_|i)|i) : 2,
  { apply eval_freeCond'_iso_aux_zero },
  { apply is_zero.eq_of_src, apply is_zero_zero },
  { apply eval_freeCond'_iso_aux_neg },
end

def eval_freeAb_iso (S : ExtrDisc.{u}) :
  Condensed_Ab_to_presheaf ⋙ BD.eval' freeFunc ⋙
  ((category_theory.evaluation _ _).obj (op S.val)).map_homological_complex _ ≅
  evaluation _ S.val ⋙ BD.eval' (category_theory.forget _ ⋙ AddCommGroup.free) :=
nat_iso.of_components
(λ M, eval_freeAb_iso_component _ _ _)
begin
  intros X Y f,
  ext ((_|i)|i) : 2,
  { change AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) ≫ AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) =
      AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) ≫ AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _),
    simp only [← functor.map_comp], congr' 2,
    apply biproduct.hom_ext, intros j,
    dsimp [functor.map_bicone],
    simp only [category.assoc, biproduct.map_π, biproduct.lift_π],
    erw biproduct.lift_π_assoc,
    erw biproduct.lift_π,
    simp_rw [← nat_trans.comp_app, biproduct.map_π],
    refl },
  { apply is_zero.eq_of_tgt, apply is_zero_zero },
  { change AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) ≫ AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) =
      AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _) ≫ AddCommGroup.free.map ((category_theory.forget Ab.{u+1}).map _),
    simp only [← functor.map_comp], congr' 2,
    apply biproduct.hom_ext, intros j,
    dsimp [functor.map_bicone],
    simp only [category.assoc, biproduct.map_π, biproduct.lift_π],
    erw biproduct.lift_π_assoc,
    erw biproduct.lift_π,
    simp_rw [← nat_trans.comp_app, biproduct.map_π],
    refl },
end

-- Move this.
def point {A : Type u} (a : A) : punit.{u+1} ⟶ A := λ _, a

def tensor_to_unsheafified_homology_component_applied
  (M : Condensed.{u} Ab.{u+1}) (i : ℤ) (S : ExtrDisc.{u}) (m : M.val.obj (op S.val)) :
  ((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).obj
    (AddCommGroup.free.obj punit)).val.as.homology i ⟶
  (homological_complex.homology ((BD.eval' freeFunc).obj
    (Condensed_Ab_to_presheaf.obj M)) i).obj (op S.val) :=
(homotopy_category.homology_functor _ _ _).map
    ((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).map
      ((AddCommGroup.adj.hom_equiv _ _).symm (point m))) ≫
      (homology_functor _ _ _).map (eval_freeAb_iso_component _ _ _).inv ≫
    (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
      (op S.val)).homology_functor_iso _ _).inv.app _

open category_theory.preadditive

def tensor_to_unsheafified_homology_component (M : Condensed.{u} Ab.{u+1}) (i : ℤ)
  (S : ExtrDisc.{u}) :
  M.val.obj (op S.val) ⟶
  AddCommGroup.of
    (((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).obj
      (AddCommGroup.free.obj punit)).val.as.homology i ⟶
    (homological_complex.homology ((BD.eval' freeFunc).obj
      (Condensed_Ab_to_presheaf.obj M)) i).obj (op S.val)) :=
add_monoid_hom.mk' (λ m, tensor_to_unsheafified_homology_component_applied _ _ _ _ m)
begin
  intros x y, rcases i with ((_|i)|i),
  { erw [← add_comp, ← functor.map_add, ← functor.map_add], apply congr_arg2 _ _ rfl, congr' 2,
    dsimp only [AddCommGroup.adj, adjunction.mk_of_hom_equiv_hom_equiv],
    ext ⟨⟩, simp only [equiv.symm_symm, add_monoid_hom.add_apply, free_abelian_group.lift.of],
    refl },
  { apply is_zero.eq_of_src,
    apply is_zero.homology_is_zero, apply is_zero_zero },
  { erw [← add_comp, ← functor.map_add, ← functor.map_add], apply congr_arg2 _ _ rfl, congr' 2,
    dsimp only [AddCommGroup.adj, adjunction.mk_of_hom_equiv_hom_equiv],
    ext ⟨⟩, simp only [equiv.symm_symm, add_monoid_hom.add_apply, free_abelian_group.lift.of],
    refl },
end
.

lemma tensor_to_unsheafified_homology_natural (M : Condensed.{u} Ab.{u+1}) (i : ℤ) (S T : ExtrDiscᵒᵖ)
  (f : S ⟶ T)
  (x : (((ExtrSheaf_ExtrSheafProd_equiv Ab).functor.obj
             ((Condensed_ExtrSheaf_equiv Ab).inverse.obj M)).val.obj S)) :
  ((tensor_to_unsheafified_homology_component_applied BD M i (unop T)) ((M.val.map f.unop.val.op) x)) =
  ((tensor_to_unsheafified_homology_component_applied BD M i (unop S)) x) ≫
    ((homological_complex.homology ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M)) i).map f.unop.val.op) :=
begin
  dsimp only [tensor_to_unsheafified_homology_component_applied],
  rw [← nat_iso.app_inv, ← category.assoc, iso.comp_inv_eq],
  simp only [category.assoc],
  have := functor.naturality_homology_functor_iso
    ((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).map (ExtrDisc_to_Profinite.op.map f))
    (complex_shape.up ℤ) i,
  apply_fun (λ e, e.app ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M))) at this,
  dsimp [-homology_functor_map] at this, simp only [category.id_comp, category.comp_id] at this,
  erw this, rw [← nat_iso.app_inv, ← nat_iso.app_hom, iso.inv_hom_id_assoc],
  clear this,
  rw [← functor.map_iso_inv, ← category.assoc, iso.comp_inv_eq, category.assoc, category.assoc],
  dsimp [-homology_functor_map], simp only [← functor.map_comp],
  rw [← eval_freeAb_iso_component_naturality, iso.inv_hom_id_assoc],
  have :
    ((AddCommGroup.adj.hom_equiv punit (M.val.obj (op (unop T).val))).symm)
    (point ((M.val.map f.unop.val.op) x)) =
    (((AddCommGroup.adj.hom_equiv punit (M.val.obj (op (unop S).val))).symm) (point x)) ≫
    (M.val.map (ExtrDisc_to_Profinite.map f.unop).op),
  { ext ⟨⟩,
    dsimp only [AddCommGroup.adj, adjunction.mk_of_hom_equiv_hom_equiv, equiv.symm,
      equiv.to_fun_as_coe],
    simp only [comp_apply],
    erw free_abelian_group.lift.of,
    erw free_abelian_group.lift.of,
    refl },
  rw [this, functor.map_comp],
  erw [functor.map_comp],
  refl,
end

def tensor_to_unsheafified_homology (M : Condensed.{u} Ab.{u+1}) (i : ℤ) :
  (((Condensed_ExtrSheaf_equiv Ab).inverse.obj M).tensor
    (((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).obj
    (AddCommGroup.free.obj punit)).val.as.homology i)).val ⟶
  ExtrDisc_to_Profinite.op ⋙ homological_complex.homology
    ((BD.eval' freeFunc).obj (Condensed_Ab_to_presheaf.obj M)) i :=
{ app := λ S, AddCommGroup.tensor_uncurry $
    tensor_to_unsheafified_homology_component _ _ _ _,
  naturality' := λ S T f, begin
    apply AddCommGroup.tensor_ext, intros x y,
    dsimp only [ExtrSheaf.tensor, ExtrSheafProd.tensor,
      ExtrSheaf_ExtrSheafProd_equiv, ExtrSheafProd.tensor_presheaf_map,
      AddCommGroup.map_tensor, AddCommGroup.tensor_uncurry],
    erw [comp_apply, comp_apply, tensor_product.map_tmul,
      tensor_product.lift.tmul, tensor_product.lift.tmul],
    dsimp only [add_monoid_hom.coe_to_int_linear_map, linear_map.comp_apply,
      add_monoid_hom.coe_mk, functor.comp_map, Condensed_ExtrSheaf_equiv_inverse_val,
      ExtrDisc_to_Profinite_map, functor.op_map, tensor_to_unsheafified_homology_component,
      add_monoid_hom.mk'_apply],
    erw [id_apply, ← comp_apply], congr' 1,
    apply tensor_to_unsheafified_homology_natural,
  end }

def plain_eval_comparison_component (i : ℤ) (A : AddCommGroup.{u+1}) :
  A ⟶ AddCommGroup.of
  ((homotopy_category.homology_functor _ _ i).obj
    ((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).obj (AddCommGroup.free.obj punit)).val ⟶
    (homotopy_category.homology_functor _ _ i).obj
    ((BD.eval (category_theory.forget AddCommGroup ⋙ AddCommGroup.free)).obj A).val) :=
add_monoid_hom.mk' (λ a, (homotopy_category.homology_functor _ _ _).map $ (BD.eval _).map $
  (AddCommGroup.adj.hom_equiv _ _).symm (point a))
begin
  intros x y, rw [← functor.map_add, ← functor.map_add], congr' 2,
  dsimp only [AddCommGroup.adj, adjunction.mk_of_hom_equiv_hom_equiv],
  ext ⟨⟩, simp only [equiv.symm_symm, add_monoid_hom.add_apply, free_abelian_group.lift.of],
  refl
end

lemma plain_eval_comparison_natural (i : ℤ) (A B : AddCommGroup.{u+1}) (f : A ⟶ B) (x) :
  ((plain_eval_comparison_component BD i B) (f x)) =
  ((plain_eval_comparison_component BD i A) x) ≫
  (homotopy_category.homology_functor AddCommGroup (complex_shape.up ℤ) i).map
    ((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).map f) :=
begin
  dsimp only [plain_eval_comparison_component, add_monoid_hom.mk'_apply, functor.comp_map],
  rw [← functor.map_comp], congr' 1,
  erw [← (BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).map_comp], congr' 1,
  dsimp only [AddCommGroup.adj, adjunction.mk_of_hom_equiv_hom_equiv, equiv.symm, equiv.coe_fn_mk,
    equiv.to_fun_as_coe],
  ext ⟨⟩,
  simp only [free_abelian_group.lift.of, comp_apply],
  refl,
end

lemma plain_eval_comparison_natural' (i : ℤ) (A B : AddCommGroup.{u+1}) (f : A ⟶ B) :
  (AddCommGroup.tensor_functor.flip.obj
       (homological_complex.homology
          ((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).obj (AddCommGroup.free.obj punit)) i)).map f ≫
    AddCommGroup.tensor_uncurry (plain_eval_comparison_component BD i B) =
  AddCommGroup.tensor_uncurry (plain_eval_comparison_component BD i A) ≫
    (BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free) ⋙
       homology_functor AddCommGroup (complex_shape.up ℤ) i).map f :=
begin
  apply AddCommGroup.tensor_ext, intros x y,
  rw [comp_apply, comp_apply],
  dsimp only [functor.flip_obj_map, AddCommGroup.tensor_functor_map_app],
  delta AddCommGroup.tensor_uncurry AddCommGroup.map_tensor,
  dsimp only [linear_map.to_add_monoid_hom_coe],
  rw [tensor_product.map_tmul, tensor_product.lift.tmul, tensor_product.lift.tmul],
  dsimp only [add_monoid_hom.coe_to_int_linear_map, linear_map.comp_apply,
    add_monoid_hom.coe_mk],
  rw [plain_eval_comparison_natural],
  refl
end

def plain_eval_comparison (i : ℤ) :
  AddCommGroup.tensor_functor.flip.obj
  (((BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free)).obj
    (AddCommGroup.free.obj punit)).homology i) ⟶
  BD.eval' (forget AddCommGroup ⋙ AddCommGroup.free) ⋙ homology_functor _ _ i :=
{ app := λ A, AddCommGroup.tensor_uncurry $ plain_eval_comparison_component _ _ _,
  naturality' := λ A B f, by apply plain_eval_comparison_natural' }

local attribute [-simp] homology_functor_map

lemma tensor_to_unsheafified_homology_app_eq
  (M : Condensed.{u} Ab.{u+1}) (i : ℤ) (S : ExtrDisc.{u}) :
  (tensor_to_unsheafified_homology BD M i).app (op S) =
  (plain_eval_comparison BD i).app (M.val.obj (op S.val)) ≫
  (homology_functor _ _ _).map
  ((eval_freeAb_iso_component _ _ _).inv) ≫
  (((category_theory.evaluation Profinite.{u}ᵒᵖ Ab.{u+1}).obj
    (op S.val)).homology_functor_iso _ _).inv.app _  :=
begin
  rw [← nat_iso.app_inv, ← category.assoc, iso.eq_comp_inv, ← functor.map_iso_inv,
    iso.eq_comp_inv, category.assoc, functor.map_iso_hom, nat_iso.app_hom],
  apply_fun AddCommGroup.tensor_curry_equiv _ _ _,
  swap, apply add_equiv.injective,
  dsimp [plain_eval_comparison, tensor_to_unsheafified_homology],
  rw AddCommGroup.tensor_curry_uncurry,
  rw AddCommGroup.tensor_curry_uncurry_comp,
  ext x y,
  dsimp [plain_eval_comparison_component,
    tensor_to_unsheafified_homology_component],
  simp only [comp_apply],
  dsimp [preadditive_yoneda],
  simp only [comp_apply],
  dsimp [tensor_to_unsheafified_homology_component_applied],
  simp only [← comp_apply, category.assoc],
  dsimp only [← nat_iso.app_inv, ← nat_iso.app_hom],
  simp only [iso.inv_hom_id_assoc],
  congr' 2,
  simp only [← category.assoc],
  congr' 1,
  simp only [category.assoc, iso.inv_hom_id, category.comp_id,
    ← functor.map_iso_hom, ← functor.map_iso_inv],
end

def tensor_to_homology_aux (M : Condensed.{u} Ab.{u+1}) (i : ℤ) :
((Condensed_ExtrSheaf_equiv Ab).inverse.obj M).tensor
  (((BD.eval (forget AddCommGroup ⋙ AddCommGroup.free)).obj
  (AddCommGroup.free.obj punit)).val.as.homology i) ⟶
  (presheaf_to_Sheaf ExtrDisc.proetale_topology Ab).obj
  (ExtrDisc_to_Profinite.op ⋙
     homological_complex.homology ((BD.eval' freeFunc).obj
     (Condensed_Ab_to_presheaf.obj M)) i) := Sheaf.hom.mk $
tensor_to_unsheafified_homology _ _ _ ≫ grothendieck_topology.to_sheafify _ _

def tensor_to_homology (M : Condensed.{u} Ab.{u+1}) (i : ℤ) :
  (tensor M $ ((BD.eval $
    category_theory.forget AddCommGroup ⋙ AddCommGroup.free).obj
    (AddCommGroup.free.obj punit)).val.as.homology i) ⟶
  ((BD.eval freeCond').obj M).val.as.homology i :=
(Condensed_ExtrSheaf_equiv Ab).functor.map
  (tensor_to_homology_aux _ _ _ ≫ ExtrDisc_sheafification_iso.hom.app _)
≫ ((Condensed_ExtrSheaf_equiv _).counit_iso.app _).hom
≫ (homology_functor_sheafification_iso _ _).hom.app _
≫ (homology_functor _ _ _).map (eval_freeCond'_iso_component _ _).inv

.

instance preserves_filtered_colimits_tensor_flip (A) :
  preserves_filtered_colimits (AddCommGroup.tensor_functor.flip.obj A) :=
infer_instance

instance preserves_filtered_colimits_tensor_flip_eval' (i : ℤ) :
  preserves_filtered_colimits
  (AddCommGroup.tensor_functor.flip.obj (homological_complex.homology
    ((BD.eval' (forget AddCommGroup.{u+1} ⋙ AddCommGroup.free)).obj
    (AddCommGroup.free.obj punit)) i)) :=
Condensed.preserves_filtered_colimits_tensor_flip _

set_option pp.universes true

instance additive_tensor_flip (A : AddCommGroup.{u}) : functor.additive
  (AddCommGroup.tensor_functor.flip.obj A) :=
{ map_add' := λ X Y f g, begin
    dsimp [AddCommGroup.map_tensor], ext x,
    dsimp only [linear_map.to_add_monoid_hom_coe, add_monoid_hom.add_apply],
    rw [← linear_map.add_apply],
    congr' 1, apply tensor_product.ext', intros x y,
    apply tensor_product.add_tmul,
  end }

instance additive_tensor_flip_eval' (i : ℤ) : functor.additive
  (AddCommGroup.tensor_functor.flip.obj (homological_complex.homology
    ((BD.eval' (forget AddCommGroup.{u+1} ⋙ AddCommGroup.free)).obj
    (AddCommGroup.free.obj punit)) i)) :=
Condensed.additive_tensor_flip _

-- move me
instance AddCommGroup.free_preserves_limits : preserves_colimits AddCommGroup.free :=
AddCommGroup.adj.left_adjoint_preserves_colimits

instance preserves_filtered_colimits_eval'_forget_free :
  preserves_filtered_colimits.{u+1 u+2 u+2}
    (BD.eval' (forget.{u+2 u+1 u+1} AddCommGroup.{u+1} ⋙ AddCommGroup.free.{u+1})) :=
begin
  apply_with limits.comp_preserves_filtered_colimits.{u+1 u+2 _ u+2} {instances:=ff},
  { apply_with data.eval_functor_preserves_filtered_colimits {instances:=ff},
    apply limits.comp_preserves_filtered_colimits.{u+1 u+2 _ u+2}, },
  { constructor,
    intro J,
    introI,
    introI,
    apply_instance, },
end

instance preserves_filtered_colimits_homology (i : ℤ) :
  preserves_filtered_colimits.{u+1 u+2 u+2}
    (homology_functor.{u+1 u+2 0} AddCommGroup.{u+1} (complex_shape.up.{0} ℤ) i) :=
⟨λ J, begin
  introI,
  introI,
  constructor,
  intro K,
  apply_instance,
end⟩

instance preserves_filtered_colimits_eval'_forget_free_homology (i : ℤ) :
  preserves_filtered_colimits
  (BD.eval' (forget AddCommGroup.{u+1} ⋙ AddCommGroup.free) ⋙
    homology_functor AddCommGroup.{u+1} (complex_shape.up ℤ) i) :=
limits.comp_preserves_filtered_colimits.{u+1 u+2 _ u+2}
  (BD.eval' (forget AddCommGroup.{u+1} ⋙ AddCommGroup.free))
  (homology_functor AddCommGroup.{u+1} (complex_shape.up ℤ) i)

instance _root_.bounded_homotopy_category.forget_additive (𝓐 : Type*) [category 𝓐] [abelian 𝓐] :
  (bounded_homotopy_category.forget 𝓐).additive :=
{ map_add' := λ X Y f g, rfl }

instance additive_eval'_forget_free (i : ℤ) : functor.additive
  (BD.eval' (forget AddCommGroup.{u+1} ⋙ AddCommGroup.free) ⋙
    homology_functor AddCommGroup.{u+1} (complex_shape.up ℤ) i) :=
begin
  show functor.additive (
    (BD.eval (forget AddCommGroup.{u+1} ⋙ AddCommGroup.free) ⋙ bounded_homotopy_category.forget _) ⋙
      homotopy_category.homology_functor _ _ i),
  exact functor.comp.additive (package.eval BD (forget AddCommGroup ⋙ AddCommGroup.free) ⋙ forget AddCommGroup)
  (homotopy_category.homology_functor AddCommGroup (complex_shape.up ℤ) i)
end
.

lemma coeff_star_smul (x : free_abelian_group.{u} punit) :
  free_abelian_group.coeff punit.star x • free_abelian_group.of.{u} punit.star = x :=
begin
  refine free_abelian_group.induction_on'' x _ _ _; clear x,
  { simp only [map_zero, zero_smul], },
  { rintro n hn ⟨⟩, simp only [map_zsmul, free_abelian_group.coeff_of_self, smul_assoc, one_smul], },
  { rintro x n hn ⟨⟩ hx IH1 IH2, simp only [map_add, add_smul, IH1, IH2], },
end

lemma AddCommGroup.adj_hom_equiv_punit (a) :
  ((AddCommGroup.adj.{u+1}.hom_equiv punit.{u+2}
    (AddCommGroup.free.{u+1}.obj punit.{u+2})).symm) (point.{u+1} a) =
    (free_abelian_group.coeff punit.star a) • 𝟙 _ :=
begin
  dsimp only [AddCommGroup.adj, adjunction.mk_of_hom_equiv_hom_equiv, equiv.symm, equiv.coe_fn_mk, equiv.to_fun_as_coe],
  ext ⟨⟩,
  rw [free_abelian_group.lift.of, add_monoid_hom.smul_apply, id_apply, coeff_star_smul],
  refl
end

lemma homology_functor.map_id_bo_ho_ca {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  (X : bounded_homotopy_category 𝓐) (i : ℤ) :
  (homotopy_category.homology_functor _ (complex_shape.up ℤ) i).map (𝟙 X : _) =
    𝟙 ((homotopy_category.homology_functor _ (complex_shape.up ℤ) i).obj X.val) :=
category_theory.functor.map_id _ _

lemma plain_eval_comparison_is_iso_aux (A : AddCommGroup) :
  is_iso (AddCommGroup.tensor_uncurry $ add_monoid_hom.mk' (λ (a : (AddCommGroup.free.obj punit)),
     (free_abelian_group.coeff punit.star) a • 𝟙 A) $ by intros; simp only [map_add, add_smul]) :=
begin
  constructor,
  refine ⟨add_monoid_hom.mk' (λ a, free_abelian_group.of punit.star ⊗ₜ a) _, _, _⟩,
  { intros, rw tensor_product.tmul_add, },
  { apply AddCommGroup.tensor_ext, intros x y,
    erw [comp_apply, id_apply],
    dsimp only [AddCommGroup.tensor_uncurry, add_monoid_hom.mk'_apply,
      linear_map.to_add_monoid_hom_coe],
    rw [tensor_product.lift.tmul],
    dsimp only [add_monoid_hom.coe_to_int_linear_map, linear_map.comp_apply,
      add_monoid_hom.coe_mk, add_monoid_hom.mk'_apply, add_monoid_hom.smul_apply],
    rw [← tensor_product.smul_tmul, id_apply, coeff_star_smul], },
  { ext a, rw [id_apply, comp_apply],
    dsimp only [AddCommGroup.tensor_uncurry, add_monoid_hom.mk'_apply,
      linear_map.to_add_monoid_hom_coe],
    rw [tensor_product.lift.tmul],
    dsimp only [add_monoid_hom.coe_to_int_linear_map, linear_map.comp_apply,
      add_monoid_hom.coe_mk, add_monoid_hom.mk'_apply, add_monoid_hom.smul_apply],
    rw [free_abelian_group.coeff_of_self, one_smul], refl }
end

instance (i : ℤ) : is_iso ((plain_eval_comparison BD i).app
  (AddCommGroup.free.obj (punit : Type (u+1)))) :=
begin
  dsimp only [plain_eval_comparison, plain_eval_comparison_component],
  simp only [AddCommGroup.adj_hom_equiv_punit, functor.map_smul,
    category_theory.functor.map_id, homology_functor.map_id_bo_ho_ca],
  apply plain_eval_comparison_is_iso_aux
end

lemma AddCommGroup.free_punit_is_tensor_unit :
  (AddCommGroup.free.{u+1}.obj punit.{u+2}).is_tensor_unit :=
begin
  constructor, intros B, swap, exact free_abelian_group.of punit.star,
  split, { intros f g h, ext ⟨⟩, exact h },
  intros b, refine ⟨free_abelian_group.lift (point b), _⟩,
  dsimp only, rw [free_abelian_group.lift.of], refl,
end

instance is_iso_map_tensor_to_homology_aux_comp (M : Condensed.{u} Ab.{u+1}) (i : ℤ)
  [∀ S : ExtrDisc.{u}, no_zero_smul_divisors ℤ (M.val.obj (op S.val))] :
  is_iso (tensor_to_homology_aux BD M i) :=
begin
  suffices : ∀ (X : ExtrDisc), is_iso ((tensor_to_unsheafified_homology BD M i).app (op X)),
  { resetI,
    apply Sheaf.is_iso_of_eval _ (tensor_to_homology_aux BD M i)
      (tensor_to_unsheafified_homology _ _ _) rfl },
  intros S,
  rw tensor_to_unsheafified_homology_app_eq,
  suffices : is_iso ((plain_eval_comparison BD i).app (M.val.obj (op S.val))),
  { resetI, apply is_iso.comp_is_iso },
  apply AddCommGroup.is_iso_of_preserves_of_is_tensor_unit.{u+1 u+2} _ _
    (plain_eval_comparison BD i) (AddCommGroup.free.obj punit),
  apply AddCommGroup.free_punit_is_tensor_unit,
end

instance is_iso_tensor_to_homology (M : Condensed.{u} Ab.{u+1}) (i : ℤ)
  [∀ S : ExtrDisc.{u}, no_zero_smul_divisors ℤ (M.val.obj (op S.val))] :
  is_iso (tensor_to_homology BD M i) :=
begin
  dsimp only [tensor_to_homology],
  apply is_iso.comp_is_iso,
end

def homology_bd_eval (M : Condensed.{u} Ab.{u+1})
  [∀ S : ExtrDisc.{u}, no_zero_smul_divisors ℤ (M.val.obj (op S.val))] (i : ℤ) :
  ((BD.eval freeCond').obj M).val.as.homology i ≅
  (tensor M $ ((BD.eval $
    category_theory.forget AddCommGroup ⋙ AddCommGroup.free).obj
      (AddCommGroup.free.obj punit)).val.as.homology i) :=
(as_iso (tensor_to_homology BD M i)).symm

section
variables (M N : Condensed.{u} Ab.{u+1}) (f : M ⟶ N)

set_option pp.universes false

@[simp] lemma embed_f_0 {𝓐 : Type*} [category 𝓐] [abelian 𝓐]
  {X Y : chain_complex 𝓐 ℕ} (f : X ⟶ Y) :
  ((homological_complex.embed complex_shape.embedding.nat_down_int_up).map f).f 0 = f.f 0 := rfl

@[simp] lemma embed_f_neg {𝓐 : Type*} [category 𝓐] [abelian 𝓐]
  {X Y : chain_complex 𝓐 ℕ} (f : X ⟶ Y) (n : ℕ) :
  ((homological_complex.embed complex_shape.embedding.nat_down_int_up).map f).f -[1+ n] = f.f (n+1) := rfl

lemma eval_freeCond'_iso_component_zero_natural :
  (eval_freeCond'_iso.component_zero BD M).inv ≫ ((BD.eval' freeCond').map f).f 0 =
  ((presheaf_to_Condensed_Ab.map_homological_complex (complex_shape.up ℤ)).map
    ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))).f 0 ≫
      (eval_freeCond'_iso.component_zero BD N).inv :=
begin
  dsimp only [eval_freeCond'_iso.component_zero, package.eval',
    functor.map_iso_trans, iso.trans_inv, functor.map_iso_inv,
    iso_whisker_right_inv,
    functor.map_homological_complex_map_f, functor.comp_map,
    functor.comp_obj, functor.flip_obj_map, homological_complex.functor_eval,
    embed_f_0, data.eval_functor, data.eval_functor'_obj_X_map],
  simp only [functor.map_biproduct, category.assoc],
  simp only [biproduct.unique_up_to_iso_inv, functor.map_comp,
    Condensed_Ab_to_CondensedSet_map, CondensedSet_to_Condensed_Ab_map,
    whisker_right_twice, category.assoc, whiskering_right_obj_map],
  dsimp only [presheaf_to_Condensed_Ab],
  simp only [← functor.map_comp], congr' 1,
  ext t : 2, dsimp only [nat_trans.comp_app, whisker_right_app, functor.associator],
  simp only [category.id_comp, category.comp_id],
  simp only [← functor.map_comp], congr' 1,
  simp only [← nat_trans.comp_app], congr' 1,
  apply biproduct.hom_ext', intros j,
  simp only [category.assoc, biproduct.ι_desc_assoc, biproduct.ι_desc,
    biproduct.ι_map_assoc],
  dsimp only [functor.map_bicone, Condensed_Ab_to_presheaf, ← Sheaf_to_presheaf_map],
  simp only [← functor.map_comp], congr' 1,
  erw biproduct.ι_map,
end

lemma eval_freeCond'_iso_component_neg_natural (n : ℕ) :
  (eval_freeCond'_iso.component_neg BD M n).inv ≫ ((BD.eval' freeCond').map f).f (-[1+ n]) =
  ((presheaf_to_Condensed_Ab.map_homological_complex (complex_shape.up ℤ)).map
    ((BD.eval' freeFunc).map (Condensed_Ab_to_presheaf.map f))).f -[1+ n] ≫
      (eval_freeCond'_iso.component_neg BD N n).inv :=
begin
  dsimp only [eval_freeCond'_iso.component_neg, package.eval',
    functor.map_iso_trans, iso.trans_inv, functor.map_iso_inv,
    iso_whisker_right_inv,
    functor.map_homological_complex_map_f, functor.comp_map,
    functor.comp_obj, functor.flip_obj_map, homological_complex.functor_eval,
    embed_f_neg, data.eval_functor, data.eval_functor'_obj_X_map],
  simp only [functor.map_biproduct, category.assoc],
  simp only [biproduct.unique_up_to_iso_inv, functor.map_comp,
    Condensed_Ab_to_CondensedSet_map, CondensedSet_to_Condensed_Ab_map,
    whisker_right_twice, category.assoc, whiskering_right_obj_map],
  dsimp only [presheaf_to_Condensed_Ab],
  simp only [← functor.map_comp], congr' 1,
  ext t : 2, dsimp only [nat_trans.comp_app, whisker_right_app, functor.associator],
  simp only [category.id_comp, category.comp_id],
  simp only [← functor.map_comp], congr' 1,
  simp only [← nat_trans.comp_app], congr' 1,
  apply biproduct.hom_ext', intros j,
  simp only [category.assoc, biproduct.ι_desc_assoc, biproduct.ι_desc,
    biproduct.ι_map_assoc],
  dsimp only [functor.map_bicone, Condensed_Ab_to_presheaf, ← Sheaf_to_presheaf_map],
  simp only [← functor.map_comp], congr' 1,
  erw biproduct.ι_map,
end

lemma eval_freeCond'_iso_component_natural :
  (eval_freeCond'_iso_component.{u} BD M).inv ≫ (BD.eval' freeCond'.{u}).map f =
  (presheaf_to_Condensed_Ab.{u}.map_homological_complex (complex_shape.up.{0} ℤ)).map
    ((BD.eval' freeFunc.{u u+1}).map (Condensed_Ab_to_presheaf.{u}.map f)) ≫
      (eval_freeCond'_iso_component.{u} BD N).inv :=
begin
  ext ((_|n)|n) : 2,
  { apply eval_freeCond'_iso_component_zero_natural },
  { apply is_zero.eq_of_tgt, exact is_zero_zero _, },
  { apply eval_freeCond'_iso_component_neg_natural },
end

end

end Condensed


import topology.category.CompHaus

namespace CompHaus

open category_theory

noncomputable instance : limits.preserves_limits (forget CompHaus) :=
by apply limits.comp_preserves_limits CompHaus_to_Top (forget Top)

@[simp] lemma coe_id (X : CompHaus) : (𝟙 X : X → X) = id := rfl
@[simp] lemma coe_comp {A B C : CompHaus} (f : A ⟶ B) (g : B ⟶ C) :
  (f ≫ g : A → C) = g ∘ f := rfl

lemma coe_id_apply {X : CompHaus} (x : X) : (𝟙 X : X → X) x = x := by simp
lemma coe_comp_apply {X Y Z : CompHaus} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) :
  (f ≫ g) x = g (f x) := by simp

end CompHaus