import Lbar.ext_aux1

noncomputable theory

universes v u u'

open opposite category_theory category_theory.limits category_theory.preadditive
open_locale nnreal zero_object

variables (r r' : ℝ≥0)
variables [fact (0 < r)] [fact (r < r')] [fact (r < 1)]

section

open bounded_homotopy_category

variables (BD : breen_deligne.data)
variables (κ κ₂ : ℝ≥0 → ℕ → ℝ≥0)
variables [∀ (c : ℝ≥0), BD.suitable (κ c)] [∀ n, fact (monotone (function.swap κ n))]
variables [∀ (c : ℝ≥0), BD.suitable (κ₂ c)] [∀ n, fact (monotone (function.swap κ₂ n))]
variables (M : ProFiltPseuNormGrpWithTinv₁.{u} r')
variables (V : SemiNormedGroup.{u})

lemma QprimeFP_map (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) :
  (QprimeFP r' BD κ M).map h = of'_hom ((QprimeFP_int r' BD κ _).map h) := rfl

instance aaahrg (X : Profinite) : semi_normed_group (locally_constant X V) :=
locally_constant.semi_normed_group

def V_T_inv (r : ℝ≥0) (V : SemiNormedGroup.{u}) [normed_with_aut r V] : V ⟶ V :=
normed_with_aut.T.{u}.inv

variables [fact (0 < r')] [fact (r' < 1)]

section

variables [complete_space V] [separated_space V]

set_option pp.universes true

lemma final_boss_aux₁ (X : Profinite) (x) :
 ((LCC_iso_Cond_of_top_ab_add_equiv.{u} X V).symm) x =
 (LCC_iso_Cond_of_top_ab_equiv X V).symm x := rfl

lemma final_boss_aux₂ [normed_with_aut r V] (X : Profinite) (x : locally_constant X V) :
((locally_constant.map_hom.{u u u} (V_T_inv r V)).completion)
  (uniform_space.completion.cpkg.{u}.coe x) =
  uniform_space.completion.map (locally_constant.map_hom (V_T_inv r V)) x := rfl

-- should this be a global instance earlier in mathlib?
local attribute [instance]
abstract_completion.uniform_struct

lemma final_boss_aux₃ [normed_with_aut r V] (X : Profinite) :
  continuous.{u u}
  (λ (x : C(X,V)),
  ((locally_constant.map_hom.{u u u} normed_with_aut.T.{u}.inv).completion)
  (((uniform_space.completion.cpkg.{u}.compare_equiv (locally_constant.pkg.{u} X ↥V)).symm) x)) :=
begin
  dsimp [abstract_completion.compare_equiv],
  refine (normed_group_hom.continuous _).comp _,
  refine ((locally_constant.pkg X V).uniform_continuous_compare _).continuous,
end

example {β : Type*} [uniform_space β] (a : abstract_completion β) : uniform_space a.space :=
by apply_instance

lemma final_boss_aux₄ [normed_with_aut r V] (X : Profinite) :
@continuous.{u u} _ _ _ (uniform_space.completion.cpkg.uniform_struct.to_topological_space)
  (λ (x : C(X,V)),
  ((locally_constant.pkg X V).compare
    uniform_space.completion.cpkg.{u}
  {to_fun := (V_T_inv r V) ∘ x.to_fun, continuous_to_fun :=
  (normed_with_aut.T.inv.continuous.comp x.2)})) :=
begin
  let e : C(X,V) → C(X,V) := λ e, ⟨(V_T_inv r V) ∘ e,
    (V_T_inv r V).continuous.comp e.2⟩,
  have he : continuous e := continuous_map.continuous_comp
    ((⟨(V_T_inv r V), (V_T_inv r V).continuous⟩ : C(V,V))),
  refine continuous.comp _ he,
  refine ((locally_constant.pkg X V).uniform_continuous_compare _).continuous,
end

lemma final_boss [normed_with_aut r V] (X : Profinite)
  (x : ((Condensed.of_top_ab.presheaf V).obj (op X))) :
((locally_constant.map_hom (V_T_inv r V)).completion)
    (((LCC_iso_Cond_of_top_ab_add_equiv X V).symm) x) =
  ((LCC_iso_Cond_of_top_ab_add_equiv X V).symm)
    {to_fun := (normed_with_aut.T.inv) ∘ x.1, continuous_to_fun :=
      (normed_with_aut.T.inv.continuous.comp x.2)} :=
begin
  rw final_boss_aux₁,
  rw final_boss_aux₁,
  dsimp only [V_T_inv],
  dsimp only [LCC_iso_Cond_of_top_ab_equiv],
  change C(X,V) at x,
  apply abstract_completion.induction_on (locally_constant.pkg.{u} X ↥V) x,
  { apply is_closed_eq,
    { apply final_boss_aux₃ },
    { apply final_boss_aux₄ } },
  clear x,
  intros x,
  change ((locally_constant.map_hom.{u u u} normed_with_aut.T.{u}.inv).completion)
    ((locally_constant.pkg.{u} X ↥V).compare uniform_space.completion.cpkg.{u}
       ((locally_constant.pkg.{u} X ↥V).coe x)) = _,
  --dsimp [abstract_completion.compare_equiv],
  rw abstract_completion.compare_coe,
  erw final_boss_aux₂,
  erw uniform_space.completion.map_coe,
  let q : C(X,V) :=
    {to_fun := (normed_with_aut.T.{u}.inv) ∘ ((locally_constant.pkg.{u} X ↥V).coe x).to_fun,
    continuous_to_fun := _},
  swap,
  { apply continuous.comp,
    apply normed_group_hom.continuous,
    refine ((locally_constant.pkg.{u} X ↥V).coe x).2 },
  have hq : q = (locally_constant.pkg X V).coe
    ((locally_constant.map_hom.{u u u} (V_T_inv.{u} r V)) x),
  { ext, refl },

  change _ =
    ((locally_constant.pkg.{u} X ↥V).compare uniform_space.completion.cpkg) q,
  rw hq,

  rw abstract_completion.compare_coe,

  refl,

  apply normed_group_hom.uniform_continuous,
end

end

@[reassoc]
lemma massive_aux₁ (X Y : Profinite.{u}) (f : X ⟶ Y) :
  (preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map (freeCond.{u}.map f).op ≫
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond X).hom =
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond Y).hom ≫
  V.to_Cond.val.map f.op :=
begin
  erw preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_natural',
  refl,
end

lemma add_equiv.mk_symm {A B : Type*} [add_comm_group A] [add_comm_group B]
  (f : A →+ B) (g : B →+ A) (h1 h2 h3) :
  (add_equiv.mk f g h1 h2 h3).symm =
  add_equiv.mk g f h2 h1 (by { intros x y, apply h1.injective, rw [h3, h2, h2, h2] }) := rfl

lemma add_equiv.mk_symm_apply {A B : Type*} [add_comm_group A] [add_comm_group B]
  (f : A →+ B) (g : B →+ A) (h1 h2 h3) (x : B) :
  (add_equiv.mk f g h1 h2 h3).symm x = g x := rfl

lemma locally_constant.comap_hom_map_hom {X Y V W : Type*}
  [topological_space X] [compact_space X]
  [topological_space Y] [compact_space Y]
  [semi_normed_group V] [semi_normed_group W]
  (f : X → Y) (hf : continuous f) (g : normed_group_hom V W) (φ : locally_constant Y V) :
  locally_constant.comap_hom f hf (locally_constant.map_hom g φ) =
  ((locally_constant.map_hom g) ∘ (locally_constant.comap_hom f hf)) φ :=
begin
  dsimp only [locally_constant.comap_hom_apply, locally_constant.map_hom_apply, function.comp],
  rw locally_constant.comap_map,
  exact hf
end

instance (X : Profinite) :
  uniform_space.{u} (locally_constant.{u u} X V) :=
@metric_space.to_uniform_space'.{u}
  (@locally_constant.{u u} (@coe_sort.{u+2 u+2} Profinite.{u} (Type u) Profinite.has_coe_to_sort.{u} X)
     (@coe_sort.{u+2 u+2} SemiNormedGroup.{u} (Type u) SemiNormedGroup.has_coe_to_sort.{u} V)
     (Top.topological_space.{u} X.to_CompHaus.to_Top))
  (@semi_normed_group.to_pseudo_metric_space.{u}
     (@locally_constant.{u u} (@coe_sort.{u+2 u+2} Profinite.{u} (Type u) Profinite.has_coe_to_sort.{u} X)
        (@coe_sort.{u+2 u+2} SemiNormedGroup.{u} (Type u) SemiNormedGroup.has_coe_to_sort.{u} V)
        (Top.topological_space.{u} X.to_CompHaus.to_Top))
     locally_constant.semi_normed_group)

instance (X : Profinite) : topological_space ↥(V.to_Cond.val.obj (op X)) :=
@ulift.topological_space _ (continuous_map.compact_open.{u u})

variables [complete_space V] [separated_space V]

lemma to_Cond_val_map_apply (X Y : Profinite.{u}) (f : X ⟶ Y) (x) :
  V.to_Cond.val.map f.op x = ⟨continuous_map.comp_right_continuous_map V f x.down⟩ :=
rfl

lemma to_Cond_val_map (X Y : Profinite.{u}) (f : X ⟶ Y) :
  ⇑(V.to_Cond.val.map f.op) =
  (λ x, ⟨continuous_map.comp_right_continuous_map V f x.down⟩ : ↥(V.to_Cond.val.obj (op Y)) → ↥(V.to_Cond.val.obj (op X))) :=
by { ext x, rw to_Cond_val_map_apply }

lemma massive_aux₂ (X Y : Profinite.{u}) (f : X ⟶ Y) (x : (V.to_Cond.val.obj (op.{u+2} Y))) :
  uniform_space.completion.map.{u u} (locally_constant.comap_hom.{u u u} f f.continuous)
    ((locally_constant.pkg.{u} Y ↥V).compare uniform_space.completion.cpkg.{u} x.down) =
  ((locally_constant.pkg.{u} X ↥V).compare uniform_space.completion.cpkg.{u})
    ((V.to_Cond.val.map f.op) x).down :=
begin
  cases x,
  apply abstract_completion.induction_on (locally_constant.pkg.{u} Y V) x,
  { apply is_closed_eq,
    { apply uniform_space.completion.continuous_map.comp,
      apply (abstract_completion.uniform_continuous_compare _ _).continuous },
    { apply (abstract_completion.uniform_continuous_compare _ _).continuous.comp,
      let φ : C(Y, V) → C(X, V) := _, change continuous φ,
      let ψ := V.to_Cond.val.map f.op, have hψ : φ = ulift.down ∘ ψ ∘ ulift.up := rfl,
      rw hψ, clear hψ,
      refine continuous_induced_dom.comp _,
      refine continuous.comp _ continuous_ulift_up,
      rw [to_Cond_val_map],
      refine continuous.comp _ _, { exact continuous_ulift_up },
      dsimp only [Condensed.of_top_ab, Condensed.of_top_ab.presheaf],
      exact (map_continuous (continuous_map.comp_right_continuous_map ↥V f)).comp continuous_induced_dom, } },
  { intro φ,
    dsimp only,
    simp only [abstract_completion.compare_coe, to_Cond_val_map_apply,
      uniform_space.completion.map],
    rw [abstract_completion.map_coe],
    swap,
    { letI : semi_normed_group (locally_constant ↥(X.to_CompHaus.to_Top) ↥V),
      { exact locally_constant.semi_normed_group },
      letI : semi_normed_group (locally_constant ↥(Y.to_CompHaus.to_Top) ↥V),
      { exact locally_constant.semi_normed_group },
      exact normed_group_hom.uniform_continuous _, },
    have : (continuous_map.comp_right_continuous_map ↥V f) ((locally_constant.pkg Y V).coe φ) =
      (locally_constant.pkg X V).coe _ := _,
    rw [this, abstract_completion.compare_coe],
    ext1,
    erw [locally_constant.coe_comap],
    refl,
    exact f.continuous },
end

lemma massive_aux (X Y : Profinite.{u}) (f : X ⟶ Y) :
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond Y).hom ≫
      Ab.ulift.{u+1 u}.map ((LCC_iso_Cond_of_top_ab.{u} V).inv.app (op.{u+2} Y)) ≫
        (ExtQprime_iso_aux_system_obj_aux'.{u} V Y).hom ≫
          (forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map
            ((FreeAb.eval.{u+1 u+2} SemiNormedGroup.{u+1}ᵒᵖ).map
              ((CLC.{u+1 u} (SemiNormedGroup.ulift.{u+1 u}.obj V)).right_op.map_FreeAb.map
                  ((FreeAb.of_functor.{u+1 u} Profinite.{u}).map f))).unop =
    (preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map
        ((FreeAb.eval.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1})).map
          (freeCond.{u}.map_FreeAb.map ((FreeAb.of_functor.{u+1 u} Profinite.{u}).map f))).op ≫
      (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond X).hom ≫
        Ab.ulift.{u+1 u}.map ((LCC_iso_Cond_of_top_ab.{u} V).inv.app (op.{u+2} X)) ≫
          (ExtQprime_iso_aux_system_obj_aux'.{u} V X).hom :=
begin
  dsimp only [functor.map_FreeAb, FreeAb.of_functor, FreeAb.eval],
  simp only [free_abelian_group.map_of_apply, free_abelian_group.lift.of, id],
  dsimp only [functor.right_op_map, quiver.hom.op_unop, quiver.hom.unop_op],
  rw massive_aux₁_assoc, congr' 1,
  ext1 x, simp only [comp_apply],
  dsimp only [ExtQprime_iso_aux_system_obj_aux', LCC_iso_Cond_of_top_ab,
    LCC_iso_Cond_of_top_ab_add_equiv, LCC_iso_Cond_of_top_ab_equiv, CLC, LC, functor.comp_map,
    Condensed.of_top_ab],
  simp only [add_equiv.to_fun_eq_coe, normed_group_hom.completion_coe_to_fun,
    add_equiv.to_AddCommGroup_iso_hom, add_equiv.coe_to_add_monoid_hom, add_equiv.trans_apply,
    add_equiv.ulift_apply, equiv.to_fun_as_coe, equiv.ulift_apply_2,
    Ab.ulift_map_apply_down, add_equiv.coe_mk, nat_iso.of_components.inv_app,
    add_equiv.to_AddCommGroup_iso, add_equiv.mk_symm,
    SemiNormedGroup.forget₂_Ab_map, normed_group_hom.coe_to_add_monoid_hom],
  let F := SemiNormedGroup.Completion.{u+1}.map ((SemiNormedGroup.LocallyConstant.{u+1 u}.obj
    (SemiNormedGroup.ulift.{u+1 u}.obj V)).map f.op),
  let g := _,
  let Z := _,
  change F ((uniform_space.completion.map g) Z) = _,
  change (F ∘ uniform_space.completion.map g) Z = _,
  erw [uniform_space.completion.map_comp],
  rotate,
  { apply normed_group_hom.uniform_continuous, },
  { apply normed_group_hom.uniform_continuous, },
  conv_lhs
  { dsimp only [function.comp, normed_group_hom.coe_to_add_monoid_hom, g,
      SemiNormedGroup.LocallyConstant_obj_map], },
  simp only [locally_constant.comap_hom_map_hom],
  letI : uniform_space.{u} (locally_constant.{u u} ↥(unop.{u+2} (op.{u+2} X)) ↥V) := _,
  erw [← uniform_space.completion.map_comp],
  rotate,
  { apply normed_group_hom.uniform_continuous, },
  { apply normed_group_hom.uniform_continuous, },
  dsimp only [function.comp, Z, quiver.hom.unop_op],
  congr' 1, clear Z g F,
  exact massive_aux₂ V X Y f x,
end

lemma massive (X Y : FreeAb Profinite.{u}) (f : X ⟶ Y) :
  (((preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond Y.as).hom ≫
    (Condensed_Ab_to_presheaf.{u}.map (Condensed_LCC_iso_of_top_ab.{u} V).inv).app (op.{u+2} Y.as) ≫
    (ExtQprime_iso_aux_system_obj_aux'.{u} V Y.as).hom) ≫
    (𝟙 _)) ≫
    (forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map
      (((CLC.{u+1 u} (SemiNormedGroup.ulift.{u+1 u}.obj V)).right_op.map_FreeAb ⋙
        FreeAb.eval.{u+1 u+2} SemiNormedGroup.{u+1}ᵒᵖ).map f).unop =
  (preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map
    ((freeCond.{u}.map_FreeAb ⋙ FreeAb.eval.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1})).map f).op ≫
    ((preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab.{u} V.to_Cond X.as).hom ≫
    (Condensed_Ab_to_presheaf.{u}.map (Condensed_LCC_iso_of_top_ab.{u} V).inv).app (op.{u+2} X.as) ≫
    (ExtQprime_iso_aux_system_obj_aux'.{u} V X.as).hom) ≫  𝟙 _ :=
begin
  simp only [Condensed_Ab_to_presheaf_map, category.assoc, category.comp_id, functor.comp_map],
  dsimp only [Condensed_LCC_iso_of_top_ab, Sheaf.iso.mk_inv_val,
    iso_whisker_right_inv, whisker_right_app],
  apply free_abelian_group.induction_on f; clear f,
  { simp only [functor.map_zero, unop_zero, comp_zero, op_zero, zero_comp], },
  { apply massive_aux },
  { intros f hf,
    simp only [functor.map_neg, unop_neg, op_neg, comp_neg, neg_comp, hf], },
  { intros f g hf hg,
    simp only [functor.map_add, unop_add, op_add, comp_add, add_comp, hf, hg], },
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_c (c₁ c₂) (h : c₁ ⟶ c₂) :
  (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c₂).hom ≫
  (category_theory.functor.map _ h.op) =
  (category_theory.functor.map _
  begin
    refine homological_complex.op_functor.map (quiver.hom.op _),
    refine category_theory.functor.map _ h,
  end) ≫ (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c₁).hom :=
begin
  ext n : 2,
  have aux : ∀ (n : ℕ), (monotone.{0 0} (function.swap.{1 1 1} κ n)),
  { intro n, exact fact.out _ },
  haveI : fact (κ c₁ n ≤ κ c₂ n) := ⟨aux n h.le⟩,
  have := massive V
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ c₁ n)
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ c₂ n)
    ((breen_deligne.FP2.res.{u} r' _ _ _).app ⟨M⟩),
  exact this
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_κ (c : (ℝ≥0))
  [∀ (c : ℝ≥0) (n : ℕ), fact (κ₂ c n ≤ κ c n)] :
  (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c).hom ≫
  (whisker_right (aux_system.res _ _ _ _ _ _) _).app _ =
  begin
    refine category_theory.functor.map _ _,
    refine homological_complex.op_functor.map (quiver.hom.op _),
    refine (QprimeFP_nat.ι BD κ₂ κ M).app _,
  end ≫ (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ₂ M V c).hom :=
begin
  ext n : 2,
  have := massive V
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ₂ c n)
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ c n)
    ((breen_deligne.FP2.res.{u} r' _ _ _).app ⟨M⟩),
  exact this
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_Tinv (c : ℝ≥0)
  [∀ (c : ℝ≥0) (n : ℕ), fact (κ₂ c n ≤ r' * κ c n)] :
  (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ M V c).hom ≫
  (whisker_right
    (aux_system.Tinv _ _ _ _ _ _) _).app _ =
  begin
    refine category_theory.functor.map _ _,
    refine homological_complex.op_functor.map (quiver.hom.op _),
    refine (QprimeFP_nat.Tinv BD κ₂ κ M).app _,
  end
  ≫ (hom_complex_QprimeFP_nat_iso_aux_system r' BD κ₂ M V c).hom :=
begin
  ext n : 2,
  have := massive V
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ₂ c n)
    (breen_deligne.FPsystem.X.{u} r' BD ⟨M⟩ κ c n)
    (((breen_deligne.FPsystem.Tinv.{u} r' BD ⟨M⟩ κ₂ κ).app c).f n),
  exact this,
end

def to_Cond_T_inv (r : ℝ≥0) (V : SemiNormedGroup.{u}) [normed_with_aut r V] : V.to_Cond ⟶ V.to_Cond :=
(Condensed.of_top_ab_map.{u} (normed_group_hom.to_add_monoid_hom.{u u} normed_with_aut.T.{u}.inv)
  (normed_group_hom.continuous _))

lemma uniform_space.completion.map_comp'
  {α β γ : Type*} [uniform_space α] [uniform_space β] [uniform_space γ]
  {g : β → γ} {f : α → β}
  (hg : uniform_continuous g) (hf : uniform_continuous f) (x) :
  uniform_space.completion.map g (uniform_space.completion.map f x) =
  uniform_space.completion.map (g ∘ f) x :=
begin
  rw [← uniform_space.completion.map_comp hg hf],
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv_aux_helper
  (r : ℝ≥0) (V : SemiNormedGroup.{u}) [normed_with_aut r V] [complete_space V] [separated_space V]
  (X : Profinite.{u}) :
  (ExtQprime_iso_aux_system_obj_aux' V X).hom ≫
  category_theory.functor.map _
  (SemiNormedGroup.Completion.map
  (nat_trans.app
    (SemiNormedGroup.LocallyConstant.map
    (category_theory.functor.map _ $ V_T_inv _ _)) _)) =
  Ab.ulift.map
  (category_theory.functor.map _ $
  category_theory.functor.map _ $
  nat_trans.app
  (SemiNormedGroup.LocallyConstant.map $ V_T_inv _ _) _) ≫
  (ExtQprime_iso_aux_system_obj_aux' V X).hom
   :=
begin
  ext1 ⟨f⟩,
  simp only [comp_apply],
  dsimp only [ExtQprime_iso_aux_system_obj_aux', add_equiv.to_AddCommGroup_iso,
    add_equiv.coe_to_add_monoid_hom, add_equiv.trans_apply],
  simp only [add_equiv.to_fun_eq_coe, SemiNormedGroup.LocallyConstant_map_app, SemiNormedGroup.Completion_map,
  normed_group_hom.completion_coe_to_fun, add_equiv.ulift_apply, equiv.to_fun_as_coe, equiv.ulift_apply_2,
  add_equiv.coe_mk, Ab.ulift_map_apply_down, SemiNormedGroup.forget₂_Ab_map,
    normed_group_hom.coe_to_add_monoid_hom],
  rw uniform_space.completion.map_comp',
  rotate,
  { apply normed_group_hom.uniform_continuous },
  { apply normed_group_hom.uniform_continuous },
  rw uniform_space.completion.map_comp',
  rotate,
  { apply normed_group_hom.uniform_continuous },
  { apply normed_group_hom.uniform_continuous },
  refl
end

lemma another_aux_lemma [normed_with_aut r V] (X : Profinite) :
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab V.to_Cond X).hom
  ≫ (Condensed_Ab_to_presheaf.map_iso (Condensed_LCC_iso_of_top_ab V)).inv.app (op X)
  ≫
  begin
    refine nat_trans.app _ _,
    refine Condensed_Ab_to_presheaf.map _,
    refine Sheaf.hom.mk _,
    dsimp [Condensed_LCC],
    refine whisker_right _ _,
    refine whisker_right _ _,
    refine SemiNormedGroup.LCC.map _,
    exact V_T_inv r V,
  end =
  (preadditive_yoneda.map
    (to_Cond_T_inv r V)).app _ ≫
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab V.to_Cond X).hom ≫
  (Condensed_Ab_to_presheaf.map_iso (Condensed_LCC_iso_of_top_ab V)).inv.app _ :=
begin
  have := preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_natural
    (to_Cond_T_inv r V) X,
  erw ← reassoc_of this,
  congr' 1,
  dsimp only [Condensed_Ab_to_presheaf, functor.map_iso_inv, nat_iso.app_inv,
    Sheaf_to_presheaf_map, id, whisker_right_app, SemiNormedGroup.LCC,
    curry, uncurry, curry_obj, functor.comp_map],
  simp only [category_theory.functor.map_id, category.comp_id],
  rw ← nat_trans.comp_app,
  rw ← Sheaf.hom.comp_val, -- how to make those commute?
  ext ⟨x⟩,
  dsimp only [Condensed_LCC_iso_of_top_ab, Sheaf.iso.mk, iso_whisker_right, to_Cond_T_inv,
    Ab.ulift],
  simp only [comp_apply],
  dsimp [Condensed.of_top_ab_map],
  simp only [comp_apply],
  dsimp [LCC_iso_Cond_of_top_ab, forget₂, has_forget₂.forget₂],
  rw nat_iso.of_components.inv_app,
  apply final_boss,
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv_aux (c : ℝ≥0)
  [normed_with_aut r V] (n : ℕ) (t) :
((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map
       (((aux_system.T_inv.{u u+1} r r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ).app
           (op.{1} c)).f n))
    ((((ExtQprime_iso_aux_system_obj_aux.{u} V).hom.app
           (((breen_deligne.FPsystem.{u} r' BD ⟨M⟩ κ).obj c).X n)).unop) t) =
  (((ExtQprime_iso_aux_system_obj_aux.{u} V).hom.app
        (((breen_deligne.FPsystem.{u} r' BD ⟨M⟩ κ).obj c).X n)).unop)
        (t ≫ to_Cond_T_inv.{u} r V) :=
begin
  /-
  Note: This should reduce to some calcuation with the sheafification adjunction,
  as well as something about completion/ulift compatibiity.
  If we can reduce this to such statements, we will be in pretty good shape.
  -/
  /- This code block is pretty slow.
  dsimp [ExtQprime_iso_aux_system_obj_aux, ExtQprime_iso_aux_system_obj_aux'],
  simp only [comp_apply],
  dsimp [forget₂, has_forget₂.forget₂, aux_system.T_inv,
    Condensed_LCC_iso_of_top_ab, LCC_iso_Cond_of_top_ab],
  rw nat_iso.of_components.inv_app,
  dsimp only [unop_op],
  -/
  dsimp only [forget₂, has_forget₂.forget₂, ExtQprime_iso_aux_system_obj_aux,
    nat_iso.of_components.hom_app, id, iso.op, iso.trans_hom, iso.symm,
    nat_iso.app_inv, aux_system.T_inv, quiver.hom.op_unop, quiver.hom.unop_op,
    homological_complex.unop],
  simp only [comp_apply],
  let X : Profinite := (((breen_deligne.FPsystem r' BD ⟨M⟩ κ).obj c).X n).as,
  have := preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_natural
    (to_Cond_T_inv r V) X,
  apply_fun (λ e, e t) at this,
  erw this, clear this,
  simp only [comp_apply],
  dsimp only [SemiNormedGroup.LocallyConstant],
  have := hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv_aux_helper r V X,
  let s := ((Condensed_Ab_to_presheaf.map_iso (Condensed_LCC_iso_of_top_ab V)).inv.app (op X))
    (((preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab V.to_Cond X).hom)
    (t)),
  apply_fun (λ e, e s) at this,
  erw this, clear this,
  simp only [comp_apply],
  congr' 1, dsimp only [s],
  simp only [← comp_apply],
  congr' 1,
  simp only [category.assoc],
  erw ← another_aux_lemma r V X,
  congr' 2,
  ext1 ⟨x⟩, dsimp only [Ab.ulift, Condensed_Ab_to_presheaf, whisker_right_app,
    Sheaf_to_presheaf],
  ext1,
  dsimp,
  congr' 2,
  dsimp only [SemiNormedGroup.LCC, curry, curry_obj, functor.comp_map, uncurry],
  simp only [category_theory.functor.map_id, category.comp_id],
  refl,
end

lemma hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv (c : ℝ≥0)
  [normed_with_aut r V] :
(hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V c).hom ≫
  ((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map_homological_complex
       (complex_shape.up.{0} ℕ)).map (nat_trans.app
        ((aux_system.T_inv.{u u+1} r r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ)) _) =
  begin
    let e := preadditive_yoneda.map (to_Cond_T_inv r V),
    let e' := nat_trans.map_homological_complex e (complex_shape.down ℕ).symm,
    let Q := ((QprimeFP_nat r' BD κ M).obj c).op,
    exact e'.app Q,
  end ≫
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V (c)).hom :=
begin
  ext n : 2, ext1 t,
  dsimp [hom_complex_QprimeFP_nat_iso_aux_system],
  simp only [comp_apply],
  dsimp [nat_iso.map_homological_complex, forget₂_unop],
  erw id_apply, erw id_apply,
  erw [functor.map_homological_complex_map_f],
  apply hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv_aux,
end

namespace ExtQprime_iso_aux_system_obj_naturality_setup

/-
lemma aux₁ (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) :
homological_complex.unop_functor.{u+2 u+1 0}.map
    (((preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
         forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
           AddCommGroup.{u+1}).right_op.map_homological_complex
        (complex_shape.up.{0} ℤ)).map
       ((homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_down_int_up).map
          ((QprimeFP_nat.{u} r' BD κ M).map h))).op ≫
  homological_complex.unop_functor.{u+2 u+1 0}.map
      ((map_homological_complex_embed.{u+2 u+2 u+1 u+1}
          (preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
             forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
               AddCommGroup.{u+1}).right_op).inv.app
         ((QprimeFP_nat.{u} r' BD κ M).obj c₁)).op ≫
    embed_unop.{u+2 u+1}.hom.app
      (op.{u+3}
         (((preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
              forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
                Ab.{u+1}).right_op.map_homological_complex
             (complex_shape.down.{0} ℕ)).obj
            ((QprimeFP_nat.{u} r' BD κ M).obj c₁))) =
  begin
    dsimp,
    let e := (QprimeFP_nat r' BD κ M).map h,
    let e₁ := ((preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
      forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
      Ab.{u+1}).right_op.map_homological_complex
      (complex_shape.down.{0} ℕ)).map e,
    let e₂ := homological_complex.unop_functor.map e₁.op,
    refine _ ≫
      (homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_up_int_down).map
      e₂,
    refine homological_complex.unop_functor.{u+2 u+1 0}.map
    ((map_homological_complex_embed.{u+2 u+2 u+1 u+1}
        (preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
           forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
             AddCommGroup.{u+1}).right_op).inv.app
       ((QprimeFP_nat.{u} r' BD κ M).obj c₂)).op ≫
    embed_unop.{u+2 u+1}.hom.app
    (op.{u+3}
       (((preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
            forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
              Ab.{u+1}).right_op.map_homological_complex
           (complex_shape.down.{0} ℕ)).obj
          ((QprimeFP_nat.{u} r' BD κ M).obj c₂)))
  end := admit

def F : ℝ≥0 ⥤
  (homological_complex.{u+1 u+2 0} AddCommGroup.{u+1} (complex_shape.down.{0} ℕ).symm)ᵒᵖ :=
QprimeFP_nat.{u} r' BD κ M ⋙
  (preadditive_yoneda_obj.{u+1 u+2} V.to_Cond ⋙
     forget₂.{u+2 u+2 u+1 u+1 u+1} (Module.{u+1 u+1} (End.{u+1 u+2} V.to_Cond))
       AddCommGroup.{u+1}).right_op.map_homological_complex
    (complex_shape.down.{0} ℕ) ⋙ homological_complex.unop_functor.right_op

@[reassoc]
lemma naturality_helper {c₁ c₂ : ℝ≥0} (h : c₁ ⟶ c₂) (n : ℕ) (w1 w2) :
  (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1} complex_shape.embedding.nat_up_int_down
   nat_up_int_down_c_iff n (-↑n) w1).hom.app
    (((preadditive_yoneda.{u+1 u+2}.obj
    V.to_Cond).right_op.map_homological_complex (complex_shape.down.{0} ℕ)).obj
     ((QprimeFP_nat.{u} r' BD κ M).obj c₂)).unop ≫
     (homology_functor _ _ _).map
     (homological_complex.map_unop _ _ $
     category_theory.functor.map _ $ category_theory.functor.map _ h) =
  category_theory.functor.map _
  (homological_complex.map_unop _ _ $
    category_theory.functor.map _ $ category_theory.functor.map _ h) ≫
    (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1} complex_shape.embedding.nat_up_int_down
  nat_up_int_down_c_iff n (-↑n) w2).hom.app
    (((preadditive_yoneda.{u+1 u+2}.obj
    V.to_Cond).right_op.map_homological_complex (complex_shape.down.{0} ℕ)).obj
    ((QprimeFP_nat.{u} r' BD κ M).obj c₁)).unop :=
admit
-/

lemma aux₁ (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) (n : ℕ) :
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V c₂).hom ≫
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
  ((aux_system.{u u+1} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ).to_Ab.map h.op) =
  (homology_functor _ _ _).map
  (category_theory.functor.map _
      (homological_complex.op_functor.map ((QprimeFP_nat r' BD κ M).map h).op)) ≫
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V c₁).hom :=
begin
  rw [← functor.map_comp, ← functor.map_comp],
  congr' 1,
  erw ← hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_c,
end

lemma aux₂ (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) (n : ℕ) :
  (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1}
    complex_shape.embedding.nat_up_int_down nat_up_int_down_c_iff n (-↑n) (by { cases n; refl})).hom.app
    (hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₂) V.to_Cond) ≫
    (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
    (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map_homological_complex
    (complex_shape.down.{0} ℕ).symm).map (homological_complex.op_functor.{u+2 u+1 0}.map
    ((QprimeFP_nat.{u} r' BD κ M).map h).op)) =
  (homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_up_int_down ⋙
  homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.down.{0} ℤ) (-↑n)).map
  (category_theory.functor.map _
      (homological_complex.op_functor.map ((QprimeFP_nat r' BD κ M).map h).op)) ≫
  (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1}
  complex_shape.embedding.nat_up_int_down nat_up_int_down_c_iff n (-↑n) (by { cases n; refl})).hom.app
  (hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₁) V.to_Cond) :=
begin
  erw nat_trans.naturality,
end

lemma aux₃ (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) (n : ℕ) :
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₂) V.to_Cond).hom ≫
  (homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_up_int_down ⋙
  homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.down.{0} ℤ) (-↑n)).map
  (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map_homological_complex
  (complex_shape.down.{0} ℕ).symm).map (homological_complex.op_functor.{u+2 u+1 0}.map
  ((QprimeFP_nat.{u} r' BD κ M).map h).op))
  =
  ((homology_functor.{u+1 u+2 0} AddCommGroup.{u+1}
  (complex_shape.up.{0} ℤ).symm (-↑n)).op.map
  (homological_complex.unop_functor.{u+2 u+1 0}.right_op.map
  (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).right_op.map_homological_complex
  (complex_shape.up.{0} ℤ)).map ((QprimeFP_int.{u} r' BD κ M).map h)))).unop ≫
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₁) V.to_Cond).hom
  :=
begin
  dsimp only [functor.op_map, functor.comp_map],
  erw [← functor.map_comp],
  erw [← functor.map_comp],
  congr' 1,
  ext ((_ | k) | k ) : 2,
  { refine (category.id_comp _).trans (category.comp_id _).symm },
  { apply is_zero.eq_of_tgt,
    exact is_zero_zero _ },
  { refine (category.id_comp _).trans (category.comp_id _).symm },
end
/-
lemma naturality_helper {c₂ : ℝ≥0} (n : ℕ) :
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₂) V.to_Cond).hom ≫
  (homological_complex.homology_embed_nat_iso.{0 0 u+2 u+1} Ab.{u+1}
  complex_shape.embedding.nat_up_int_down nat_up_int_down_c_iff n (-↑n) (by { cases n; refl})).hom.app
  (hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ M).obj c₂) V.to_Cond) =
  _
-/

end ExtQprime_iso_aux_system_obj_naturality_setup

lemma QprimeFP_acyclic (c) (k i : ℤ) (hi : 0 < i) :
  is_zero (((Ext' i).obj (op (((QprimeFP_int.{u} r' BD κ M).obj c).X k))).obj V.to_Cond) :=
begin
  rcases k with ((_|k)|k),
  { apply free_acyclic, exact hi },
  { rw [← functor.flip_obj_obj], refine functor.map_is_zero _ _, refine (is_zero_zero _).op, },
  { apply free_acyclic, exact hi },
end

lemma ExtQprime_iso_aux_system_obj_natrality (c₁ c₂ : ℝ≥0) (h : c₁ ⟶ c₂) (n : ℕ) :
  (ExtQprime_iso_aux_system_obj r' BD κ M V c₂ n).hom ≫
  (homology_functor _ _ _).map
  ((system_of_complexes.to_Ab _).map h.op)  =
  ((Ext n).map ((QprimeFP r' BD κ _).map h).op).app _ ≫
  (ExtQprime_iso_aux_system_obj r' BD κ M V c₁ n).hom :=
begin
  dsimp only [ExtQprime_iso_aux_system_obj,
    iso.trans_hom, id, functor.map_iso_hom],
  haveI : ((homotopy_category.quotient.{u+1 u+2 0}
    (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ M).obj c₁)).is_bounded_above :=
    chain_complex.is_bounded_above _,
  haveI : ((homotopy_category.quotient.{u+1 u+2 0}
    (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ M).obj c₂)).is_bounded_above :=
    chain_complex.is_bounded_above _,
  have := Ext_compute_with_acyclic_naturality
    ((QprimeFP_int.{u} r' BD κ M).obj c₁)
    ((QprimeFP_int.{u} r' BD κ M).obj c₂)
    V.to_Cond _ _
    ((QprimeFP_int.{u} r' BD κ M).map h) n,
  rotate,
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  dsimp only [functor.comp_map] at this,
  erw reassoc_of this, clear this,
  simp only [category.assoc, nat_iso.app_hom],
  congr' 1,
  rw ExtQprime_iso_aux_system_obj_naturality_setup.aux₁ r' BD κ M V c₁ c₂ h n,
  simp only [← category.assoc], congr' 1,
  simp only [category.assoc],
  rw ExtQprime_iso_aux_system_obj_naturality_setup.aux₂ r' BD κ M V c₁ c₂ h n,
  simp only [← category.assoc], congr' 1,

  exact ExtQprime_iso_aux_system_obj_naturality_setup.aux₃ r' BD κ M V c₁ c₂ h n,

  --- OLD PROOF FROM HERE
  --have := ExtQprime_iso_aux_system_obj_naturality_setup.naturality_helper r' BD κ
  --  M V h n _ _,
  --simp only [category.assoc, functor.map_comp],
  --slice_rhs 3 4
  --{ erw ← this },

  /-
  dsimp only [QprimeFP_int],
  congr' 1,
  dsimp only [nat_iso.app_hom],
  simp only [functor.map_comp, functor.comp_map, nat_trans.naturality,
    nat_trans.naturality_assoc],
  dsimp only [functor.op_map, quiver.hom.unop_op, functor.right_op_map],
  simp only [← functor.map_comp, ← functor.map_comp_assoc, category.assoc],
  dsimp [-homology_functor_map],
  rw ExtQprime_iso_aux_system_obj_naturality_setup.aux₁,
  dsimp [-homology_functor_map],
  simp only [functor.map_comp, functor.map_comp_assoc,
    category.assoc, nat_trans.naturality_assoc],
  congr' 2,
  dsimp [-homology_functor_map],
  dsimp only [← functor.comp_map, ← functor.comp_obj],
  --erw nat_trans.naturality_assoc,
  --refine congr_arg2 _ _ (congr_arg2 _ rfl _),

  --congr' 1,
  --refl,
  admit

  -/
end

def ExtQprime_iso_aux_system (n : ℕ) :
  (QprimeFP r' BD κ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) ≅
  aux_system r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1}.obj V) κ ⋙
    (forget₂ _ Ab).map_homological_complex _ ⋙ homology_functor _ _ n :=
nat_iso.of_components (λ c, ExtQprime_iso_aux_system_obj r' BD κ M V (unop c) n)
begin
  intros c₁ c₂ h,
  dsimp [-homology_functor_map],
  rw ← ExtQprime_iso_aux_system_obj_natrality,
  refl,
end

/-- The `Tinv` map induced by `M` -/
def ExtQprime.Tinv
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (n : ℤ) :
  (QprimeFP r' BD κ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) ⟶
  (QprimeFP r' BD κ₂ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) :=
whisker_right (nat_trans.op $ QprimeFP.Tinv BD _ _ M) _

/-- The `T_inv` map induced by `V` -/
def ExtQprime.T_inv [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (n : ℤ) :
  (QprimeFP r' BD κ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) ⟶
  (QprimeFP r' BD κ₂ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) :=
whisker_right (nat_trans.op $ QprimeFP.ι BD _ _ M) _ ≫ whisker_left _ ((Ext n).flip.map $ (single _ _).map $
  (Condensed.of_top_ab_map (normed_with_aut.T.inv).to_add_monoid_hom
  (normed_group_hom.continuous _)))

def ExtQprime.Tinv2 [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)]
  (n : ℤ) :
  (QprimeFP r' BD κ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) ⟶
  (QprimeFP r' BD κ₂ M).op ⋙ (Ext n).flip.obj ((single _ 0).obj V.to_Cond) :=
ExtQprime.Tinv r' BD κ κ₂ M V n - ExtQprime.T_inv r r' BD κ κ₂ M V n

namespace ExtQprime_iso_aux_system_comm_Tinv_setup

variables (c : (ℝ≥0)ᵒᵖ) (n : ℕ)
  [∀ (c : ℝ≥0) (n : ℕ), fact (κ₂ c n ≤ r' * κ c n)]

lemma aux₁  :
(homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
    (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V (unop.{1} c)).hom ≫
  ((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map_homological_complex
       (complex_shape.up.{0} ℕ) ⋙
     homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
    ((aux_system.Tinv.{u u+1} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ₂ κ).app c) =
  (homology_functor _ _ _).map
  (category_theory.functor.map _
      (homological_complex.op_functor.map (quiver.hom.op $
      (QprimeFP_nat.Tinv  BD κ₂ κ M).app _))) ≫
  (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ₂ M V (unop.{1} c)).hom :=
begin
  simp only [← functor.map_comp, functor.comp_map], congr' 1,
  apply hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_Tinv,
end

lemma aux₂ :
(homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
      (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj (unop.{1} c)) V.to_Cond).hom ≫
    (homological_complex.embed.{0 0 u+2 u+1} complex_shape.embedding.nat_up_int_down ⋙
       homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.down.{0} ℤ) (-↑n)).map
      (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).map_homological_complex (complex_shape.down.{0} ℕ).symm).map
         (homological_complex.op_functor.{u+2 u+1 0}.map ((QprimeFP_nat.Tinv.{u} BD κ₂ κ M).app (unop.{1} c)).op)) =
  (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).right_op.map_homological_complex (complex_shape.up.{0} ℤ) ⋙
        homological_complex.unop_functor.{u+2 u+1 0}.right_op ⋙
          (homology_functor.{u+1 u+2 0} AddCommGroup.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).op).map
       ((QprimeFP_int.Tinv.{u} BD κ₂ κ M).app (unop.{1} c))).unop ≫
    (homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℤ).symm (-↑n)).map
      (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond).hom :=
begin
  dsimp only [functor.op_map, functor.comp_map],
  erw [← functor.map_comp],
  erw [← functor.map_comp],
  congr' 1,
  ext ((_ | k) | k ) : 2,
  { refine (category.id_comp _).trans (category.comp_id _).symm },
  { apply is_zero.eq_of_tgt,
    exact is_zero_zero _ },
  { refine (category.id_comp _).trans (category.comp_id _).symm },
end

end ExtQprime_iso_aux_system_comm_Tinv_setup

lemma ExtQprime_iso_aux_system_comm_Tinv
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)] (n : ℕ) :
  (ExtQprime_iso_aux_system r' BD κ M V n).hom ≫
  whisker_right (aux_system.Tinv.{u} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1}.obj V) κ₂ κ)
    ((forget₂ _ _).map_homological_complex _ ⋙ homology_functor Ab.{u+1} (complex_shape.up ℕ) n) =
  ExtQprime.Tinv r' BD κ κ₂ M V n ≫
  (ExtQprime_iso_aux_system r' BD κ₂ M V n).hom :=
begin
  ext c : 2,
  dsimp only [ExtQprime_iso_aux_system_obj,
    ExtQprime_iso_aux_system,
    iso.trans_hom, id, functor.map_iso_hom, nat_iso.of_components.hom_app,
    nat_trans.comp_app],
  haveI : ((homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c))).is_bounded_above :=
     chain_complex.is_bounded_above _,
  haveI : ((homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1}) (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ₂ M).obj (unop.{1} c))).is_bounded_above :=
     chain_complex.is_bounded_above _,
  have := Ext_compute_with_acyclic_naturality
    ((QprimeFP_int.{u} r' BD κ₂ M).obj c.unop)
    ((QprimeFP_int.{u} r' BD κ M).obj c.unop)
    V.to_Cond _ _
    ((QprimeFP_int.Tinv BD κ₂ κ M).app _) n,
  rotate,
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  erw reassoc_of this, clear this, simp only [category.assoc], congr' 1,
  dsimp only [whisker_right_app],
  rw ExtQprime_iso_aux_system_comm_Tinv_setup.aux₁ r' BD κ κ₂ M V c n,
  simp only [← category.assoc], congr' 1, simp only [category.assoc],
  erw ← nat_trans.naturality,
  simp only [← category.assoc], congr' 1,
  exact ExtQprime_iso_aux_system_comm_Tinv_setup.aux₂ r' BD κ κ₂ M V c n,
end

-- lemma ExtQprime_iso_aux_system_comm_T_inv [normed_with_aut r V] (n : ℕ) (c : ℝ≥0ᵒᵖ) :
--   (ExtQprime_iso_aux_system_obj.{u} r' BD κ₂ M V (unop.{1} c) n).hom ≫
--     ((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map_homological_complex (complex_shape.up.{0} ℕ) ⋙
--    homology_functor.{u+1 u+2 0} Ab.{u+1} (complex_shape.up.{0} ℕ) n).map
--   ((aux_system.res.{u u+1} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ₂ κ).app c) =
--   ((Ext.{u+1 u+2} ↑n).flip.map
--       ((single.{u+1 u+2} (Condensed.{u u+1 u+2} Ab.{u+1}) 0).map
--           (Condensed.of_top_ab_map.{u} (normed_group_hom.to_add_monoid_hom.{u u} normed_with_aut.T.{u}.inv) _))).app
--       ((QprimeFP.{u} r' BD κ₂ M).op.obj c) ≫
--     (ExtQprime_iso_aux_system_obj.{u} r' BD κ₂ M V (unop.{1} c) n).hom :=
-- by admit

def homological_complex.map_unop {A M : Type*} [category A] [abelian A]
  {c : complex_shape M} (C₁ C₂ : homological_complex Aᵒᵖ c) (f : C₁ ⟶ C₂) :
  C₂.unop ⟶ C₁.unop :=
homological_complex.unop_functor.map f.op

namespace ExtQprime_iso_aux_system_comm_setup

include r
variables [normed_with_aut r V] [∀ (c : ℝ≥0) (n : ℕ), fact (κ₂ c n ≤ κ c n)]

def hom_complex_map_T_inv (c : (ℝ≥0)ᵒᵖ) :
  hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ M).obj (unop.{1} c)) V.to_Cond ⟶
  hom_complex_nat.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond :=
  begin
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    refine preadditive_yoneda.map _,
    refine Condensed.of_top_ab_map.{u} (normed_group_hom.to_add_monoid_hom.{u u}
      normed_with_aut.T.{u}.inv) (normed_group_hom.continuous _)
  end ≫
  (category_theory.functor.map _
      (homological_complex.op_functor.map (quiver.hom.op $
      (QprimeFP_nat.ι BD κ₂ κ M).app _)))

omit r

lemma embed_hom_complex_nat_iso₀ (c : (ℝ≥0)ᵒᵖ) : (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond).hom.f (int.of_nat 0) = 𝟙 _ := rfl

lemma embed_hom_complex_nat_iso_neg (n : ℕ) (c : (ℝ≥0)ᵒᵖ) : (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond).hom.f (-[1+ n]) = 𝟙 _ := rfl

lemma add_equiv.to_AddCommGroup_iso_apply (A B : AddCommGroup.{u})
  (e : A ≃+ B) (a : A) : e.to_AddCommGroup_iso.hom a = e a := rfl

lemma preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_apply (M) (X) (t) :
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab M X).hom t =
  yoneda'_equiv _ _ (Condensed_Ab_CondensedSet_adjunction.hom_equiv X.to_Condensed M t).val := rfl

include r

lemma aux₁ (c : (ℝ≥0)ᵒᵖ):
(hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ M V (unop.{1} c)).hom ≫
  ((forget₂.{u+2 u+2 u+1 u+1 u+1} SemiNormedGroup.{u+1} Ab.{u+1}).map_homological_complex
     (complex_shape.up.{0} ℕ)).map ((aux_system.T_inv.{u u+1} r r' BD
    ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ).app c ≫
  (aux_system.res.{u u+1} r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1 u}.obj V) κ₂ κ).app c) =
  hom_complex_map_T_inv _ _ _ _ _ _ _ _ ≫
  (hom_complex_QprimeFP_nat_iso_aux_system.{u} r' BD κ₂ M V (unop.{1} c)).hom :=
begin
  --simp only [← category_theory.functor.map_comp, functor.comp_map], congr' 1,
  dsimp only [hom_complex_map_T_inv], simp only [category.assoc],
  rw ← hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_κ r' BD κ κ₂ M V c.unop,
  simp only [functor.map_comp, ← category.assoc], congr' 1,
  apply hom_complex_QprimeFP_nat_iso_aux_system_naturality_in_T_inv

  /- -- IGNORE THIS
  ext k t : 3,
  dsimp [hom_complex_nat] at t,
  dsimp only [hom_complex_QprimeFP_nat_iso_aux_system, aux_system.T_inv,
    aux_system.res, hom_complex_nat, functor.map_iso, iso.trans_hom,
    homological_complex.unop_functor, homological_complex.comp_f,
    nat_iso.map_homological_complex, nat_iso.app_hom, iso.op_hom, quiver.hom.unop_op,
    nat_trans.map_homological_complex_app_f, ExtQprime_iso_aux_system_obj_aux,
    nat_iso.of_components.hom_app, id, iso.symm_hom, nat_iso.app_inv,
    whisker_right_app, nat_trans.op, functor.comp_map],
  simp only [category_theory.functor.map_comp],
  dsimp only [homological_complex.comp_f, functor.map_homological_complex, functor.op_obj,
    functor.unop, forget₂_unop, nat_iso.of_components.hom_app,
    homological_complex.hom.iso_of_components, iso.refl],
  simp only [category.assoc, category.id_comp],
  erw category.id_comp,
  dsimp only [functor.op, quiver.hom.unop_op],
  erw category.comp_id,
  repeat { rw [comp_apply] },
  -/ -- UUUUGGGHHH

end

lemma aux₂ (c : (ℝ≥0)ᵒᵖ) :
((((preadditive_yoneda.{u+1 u+2}.obj (Condensed.of_top_ab.{u} ↥V)).right_op.map_homological_complex
         (complex_shape.up.{0} ℤ)).obj
        ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c))).map_unop
       (((preadditive_yoneda.{u+1 u+2}.obj (Condensed.of_top_ab.{u} ↥V)).right_op.map_homological_complex
           (complex_shape.up.{0} ℤ)).obj
          ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c)))
       ((nat_trans.map_homological_complex.{u+1 u+2 0 u+2 u+1}
           (nat_trans.right_op.{u+1 u+1 u+2 u+2} (preadditive_yoneda.{u+1 u+2}.map
           (Condensed.of_top_ab_map.{u} (normed_group_hom.to_add_monoid_hom.{u u}
        normed_with_aut.T.{u}.inv) (normed_group_hom.continuous _))))
           (complex_shape.up.{0} ℤ)).app
          ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c))) ≫
     (homological_complex.unop_functor.{u+2 u+1 0}.right_op.map
        (((preadditive_yoneda.{u+1 u+2}.obj V.to_Cond).right_op.map_homological_complex (complex_shape.up.{0} ℤ)).map
           ((QprimeFP_int.ι.{u} BD κ₂ κ M).app (unop.{1} c)))).unop) ≫
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ₂ M).obj (unop.{1} c)) V.to_Cond).hom =
  (embed_hom_complex_nat_iso.{u} ((QprimeFP_nat.{u} r' BD κ M).obj (unop.{1} c)) V.to_Cond).hom ≫
  category_theory.functor.map _
  (hom_complex_map_T_inv _ _ _ _ _ _ _ _) :=
begin
  ext ((_ | k) | k ) : 2,
  { dsimp only [functor.comp],
    simp only [functor.right_op_map, quiver.hom.unop_op, category.assoc, homological_complex.comp_f,
  homological_complex.unop_functor_map_f, functor.map_homological_complex_map_f],
  rw embed_hom_complex_nat_iso₀,
  rw embed_hom_complex_nat_iso₀,
  ext, refl },
  { apply is_zero.eq_of_tgt,
    exact is_zero_zero _ },
  { dsimp only [functor.comp],
    simp only [functor.right_op_map, quiver.hom.unop_op, category.assoc, homological_complex.comp_f,
  homological_complex.unop_functor_map_f, functor.map_homological_complex_map_f],
  rw embed_hom_complex_nat_iso_neg,
  rw embed_hom_complex_nat_iso_neg,
  ext, refl },
end

end ExtQprime_iso_aux_system_comm_setup

section naturality_snd_var

variables {A : Type*} [category A] [abelian A] [enough_projectives A]
  (X : cochain_complex A ℤ)
  [((homotopy_category.quotient A (complex_shape.up.{0} ℤ)).obj X).is_bounded_above]
  {B₁ B₂ : A} (f : B₁ ⟶ B₂) -- (h₁) (h₂) (i)

@[reassoc]
lemma Ext_compute_with_acyclic_aux₁_naturality_snd_var (i)
  (e : (0 : ℤ) - i = -i) :
  (Ext_compute_with_acyclic_aux₁ X B₁ i).hom ≫
  begin
    refine nat_trans.app _ _,
    refine preadditive_yoneda.map _,
    refine category_theory.functor.map _ f,
  end =
  category_theory.functor.map _
  (category_theory.functor.map _ f) ≫
  (Ext_compute_with_acyclic_aux₁ X B₂ i).hom :=
begin
  ext t,
  simp only [comp_apply],
  dsimp [Ext_compute_with_acyclic_aux₁, Ext],
  simp only [category.assoc],
  generalize_proofs h1 h2,
  let φ₁ := λ j, (single _ j).obj B₁,
  let φ₂ := λ j, (single _ j).obj B₂,
  change t ≫ _ ≫ eq_to_hom (congr_arg φ₁ e) ≫ _ =
    _ ≫ _ ≫ _ ≫ eq_to_hom (congr_arg φ₂ e),
  induction e,
  dsimp, simp only [category.id_comp, category.comp_id],
  erw ← nat_trans.naturality,
  refl,
end

@[reassoc]
lemma Ext_compute_with_acyclic_aux₂_naturality_snd_var (i) :
  (Ext_compute_with_acyclic_aux₂ X B₁ i).hom ≫
  (homology_functor _ _ _).map
  begin
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    exact preadditive_yoneda.map f,
  end =
  nat_trans.app
  (preadditive_yoneda.map $ category_theory.functor.map _ f) _ ≫
  (Ext_compute_with_acyclic_aux₂ X B₂ i).hom :=
begin
  dsimp only [Ext_compute_with_acyclic_aux₂, unop_op],
  have := hom_single_iso_naturality_snd_var_good (of' X).replace (-i) f,
  erw ← this,
end

include f
lemma Ext_compute_with_acyclic_aux₃_naturality_snd_var (i) :
  (homology_functor _ _ _).map
  begin
    refine homological_complex.map_unop _ _ _,
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    refine nat_trans.right_op _,
    exact preadditive_yoneda.map f,
  end ≫ Ext_compute_with_acyclic_aux₃ X B₂ i =
  Ext_compute_with_acyclic_aux₃ X B₁ i ≫
  (homology_functor _ _ _).map
  begin
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    exact preadditive_yoneda.map f,
  end :=
begin
  dsimp only [Ext_compute_with_acyclic_aux₃],
  erw ← (homology_functor.{u_2 u_2+1 0} AddCommGroup.{u_2}
    (complex_shape.up.{0} ℤ).symm (-i)).map_comp,
  erw ← (homology_functor.{u_2 u_2+1 0} AddCommGroup.{u_2}
    (complex_shape.up.{0} ℤ).symm (-i)).map_comp,
  congr' 1,
  ext t x,
  dsimp [Ext_compute_with_acyclic_HomB],
  simp only [comp_apply],
  dsimp [nat_trans.map_homological_complex, functor.right_op,
    homological_complex.map_unop],
  simp only [category.assoc],
end

lemma Ext_compute_with_acyclic_naturality_snd_var
  (h₁) (h₂) (i) :
  (Ext_compute_with_acyclic X B₁ h₁ i).hom ≫
  (homology_functor _ _ _).map
  (begin
    refine homological_complex.map_unop _ _ _,
    refine nat_trans.app _ _,
    refine nat_trans.map_homological_complex _ _,
    exact (preadditive_yoneda.map f).right_op,
  end) =
  category_theory.functor.map _
  (category_theory.functor.map _ f) ≫ (Ext_compute_with_acyclic X B₂ h₂ i).hom :=
begin
  dsimp [Ext_compute_with_acyclic, - homology_functor_map],
  simp only [category.assoc],
  rw ← Ext_compute_with_acyclic_aux₁_naturality_snd_var_assoc,
  rw ← Ext_compute_with_acyclic_aux₂_naturality_snd_var_assoc,
  simp only [category.assoc], congr' 2,
  rw [is_iso.eq_comp_inv, category.assoc, is_iso.inv_comp_eq],
  apply Ext_compute_with_acyclic_aux₃_naturality_snd_var,
  simp,
end

end naturality_snd_var

lemma ExtQprime_iso_aux_system_comm [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)] (n : ℕ) :
  (ExtQprime_iso_aux_system r' BD κ M V n).hom ≫
  whisker_right (aux_system.Tinv2.{u} r r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1}.obj V) κ₂ κ)
    ((forget₂ _ _).map_homological_complex _ ⋙ homology_functor Ab.{u+1} (complex_shape.up ℕ) n) =
  ExtQprime.Tinv2 r r' BD κ κ₂ M V n ≫
  (ExtQprime_iso_aux_system r' BD κ₂ M V n).hom :=
begin
  ext c : 2, dsimp only [aux_system.Tinv2, ExtQprime.Tinv2, nat_trans.comp_app, whisker_right_app],
  simp only [sub_comp, nat_trans.app_sub, functor.map_sub, comp_sub],
  refine congr_arg2 _ _ _,
  { rw [← nat_trans.comp_app, ← ExtQprime_iso_aux_system_comm_Tinv], refl },

  dsimp only [ExtQprime_iso_aux_system_obj,
    ExtQprime_iso_aux_system,
    iso.trans_hom, id, functor.map_iso_hom, nat_iso.of_components.hom_app,
    nat_trans.comp_app],

  haveI : ((homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1})
    (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ M).obj (unop.{1} c))).is_bounded_above :=
     chain_complex.is_bounded_above _,
  haveI : ((homotopy_category.quotient.{u+1 u+2 0} (Condensed.{u u+1 u+2} Ab.{u+1})
    (complex_shape.up.{0} ℤ)).obj
     ((QprimeFP_int.{u} r' BD κ₂ M).obj (unop.{1} c))).is_bounded_above :=
     chain_complex.is_bounded_above _,
  have := Ext_compute_with_acyclic_naturality
    ((QprimeFP_int.{u} r' BD κ₂ M).obj c.unop)
    ((QprimeFP_int.{u} r' BD κ M).obj c.unop)
    V.to_Cond _ _
    ((QprimeFP_int.ι BD κ₂ κ M).app _) n,
  rotate,
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  { intros k i hi, apply QprimeFP_acyclic, exact hi },

  simp only [category.assoc], dsimp only [ExtQprime.T_inv, nat_trans.comp_app,
    whisker_right_app, whisker_left_app, functor.flip],
  let η := (Ext.{u+1 u+2} ↑n).map ((nat_trans.op.{0 u+1 0 u+2} (QprimeFP.ι.{u} BD κ₂ κ M)).app c),

  slice_rhs 1 2 { erw ← η.naturality },
  slice_rhs 2 3 { erw this },
  simp only [category.assoc], clear this η,

  let t : Condensed.of_top_ab V ⟶ _ :=
    Condensed.of_top_ab_map.{u} (normed_group_hom.to_add_monoid_hom.{u u}
      normed_with_aut.T.{u}.inv) (normed_group_hom.continuous _),
  have := Ext_compute_with_acyclic_naturality_snd_var
    ((QprimeFP_int r' BD κ M).obj c.unop) t _ _ n,
  rotate,
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  { intros k i hi, apply QprimeFP_acyclic, exact hi },
  erw ← reassoc_of this, clear this, congr' 1,
  simp only [functor.comp_map, category_theory.functor.map_comp,
    functor.op_map, quiver.hom.unop_op],
  slice_rhs 1 2 { rw ← category_theory.functor.map_comp },
  slice_lhs 4 5 { rw ← category_theory.functor.map_comp },
  simp only [category.assoc,
    ← category_theory.functor.map_comp, ← functor.map_comp_assoc],

  rw ExtQprime_iso_aux_system_comm_setup.aux₁ r r' BD κ κ₂ M V c,
  slice_lhs 2 4
  { simp only [category_theory.functor.map_comp] },

  simp only [← category.assoc], congr' 1,

  rw ExtQprime_iso_aux_system_comm_setup.aux₂ r r' BD κ κ₂ M V c,
  simp only [category_theory.functor.map_comp, category.assoc],
  congr' 1,

  rw [nat_iso.app_hom, ← nat_trans.naturality],
  congr' 1,

  -- have := Ext_compute_with_acyclic_naturality, <-- we need naturality in the other variable?!

  --simp only [category.assoc],
  --erw reassoc_of this,
   --clear this, simp only [category.assoc], congr' 1,

  /-
  rw [nat_trans.comp_app, functor.map_comp, ExtQprime.T_inv,
    nat_trans.comp_app, whisker_right_app, whisker_left_app, category.assoc],
  dsimp only [ExtQprime_iso_aux_system, nat_iso.of_components.hom_app, aux_system,
    aux_system.res, functor.comp_map],
  -/
end

lemma ExtQprime_iso_aux_system_comm' [normed_with_aut r V]
  [∀ c n, fact (κ₂ c n ≤ κ c n)] [∀ c n, fact (κ₂ c n ≤ r' * κ c n)] (n : ℕ) :
  whisker_right (aux_system.Tinv2.{u} r r' BD ⟨M⟩ (SemiNormedGroup.ulift.{u+1}.obj V) κ₂ κ)
    ((forget₂ _ _).map_homological_complex _ ⋙ homology_functor Ab.{u+1} (complex_shape.up ℕ) n) ≫
  (ExtQprime_iso_aux_system r' BD κ₂ M V n).inv =
  (ExtQprime_iso_aux_system r' BD κ M V n).inv ≫
  ExtQprime.Tinv2 r r' BD κ κ₂ M V n :=
begin
  rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp],
  apply ExtQprime_iso_aux_system_comm
end

end

section

def _root_.category_theory.functor.map_commsq
  {C D : Type*} [category C] [abelian C] [category D] [abelian D] (F : C ⥤ D) {X Y Z W : C}
  {f₁ : X ⟶ Y} {g₁ : X ⟶ Z} {g₂ : Y ⟶ W} {f₂ : Z ⟶ W} (sq : commsq f₁ g₁ g₂ f₂) :
  commsq (F.map f₁) (F.map g₁) (F.map g₂) (F.map f₂) :=
commsq.of_eq $ by rw [← F.map_comp, sq.w, F.map_comp]

end

section

variables {r'}
variables (BD : breen_deligne.package)
variables (κ κ₂ : ℝ≥0 → ℕ → ℝ≥0)
variables [∀ (c : ℝ≥0), BD.data.suitable (κ c)] [∀ n, fact (monotone (function.swap κ n))]
variables [∀ (c : ℝ≥0), BD.data.suitable (κ₂ c)] [∀ n, fact (monotone (function.swap κ₂ n))]
variables (M : ProFiltPseuNormGrpWithTinv₁.{u} r')
variables (V : SemiNormedGroup.{u}) [complete_space V] [separated_space V]

open bounded_homotopy_category

-- move me
instance eval'_is_bounded_above :
  ((homotopy_category.quotient (Condensed Ab) (complex_shape.up ℤ)).obj
    ((BD.eval' freeCond').obj M.to_Condensed)).is_bounded_above :=
by { delta breen_deligne.package.eval', refine ⟨⟨1, _⟩⟩, apply chain_complex.bounded_by_one }

variables (ι : ulift.{u+1} ℕ → ℝ≥0) (hι : monotone ι)

def Ext_Tinv2
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A B V : bounded_homotopy_category 𝓐}
  (Tinv : A ⟶ B) (ι : A ⟶ B) (T_inv : V ⟶ V) (i : ℤ) :
  ((Ext i).obj (op B)).obj V ⟶ ((Ext i).obj (op A)).obj V :=
(((Ext i).map Tinv.op).app V - (((Ext i).map ι.op).app V ≫ ((Ext i).obj _).map T_inv))

open category_theory.preadditive

def Ext_Tinv2_commsq
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A₁ B₁ A₂ B₂ V : bounded_homotopy_category 𝓐}
  (Tinv₁ : A₁ ⟶ B₁) (ι₁ : A₁ ⟶ B₁)
  (Tinv₂ : A₂ ⟶ B₂) (ι₂ : A₂ ⟶ B₂)
  (f : A₁ ⟶ A₂) (g : B₁ ⟶ B₂) (sqT : f ≫ Tinv₂ = Tinv₁ ≫ g) (sqι : f ≫ ι₂ = ι₁ ≫ g)
  (T_inv : V ⟶ V) (i : ℤ) :
  commsq
    (((Ext i).map g.op).app V)
    (Ext_Tinv2 Tinv₂ ι₂ T_inv i)
    (Ext_Tinv2 Tinv₁ ι₁ T_inv i)
    (((Ext i).map f.op).app V) :=
commsq.of_eq
begin
  delta Ext_Tinv2,
  simp only [comp_sub, sub_comp, ← nat_trans.comp_app, ← functor.map_comp, ← op_comp, sqT,
    ← nat_trans.naturality, ← nat_trans.naturality_assoc, category.assoc, sqι],
end

open category_theory.preadditive

lemma auux
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A₁ B₁ A₂ B₂ : cochain_complex 𝓐 ℤ}
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A₁).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj B₁).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A₂).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj B₂).is_bounded_above]
  {f₁ : A₁ ⟶ B₁} {f₂ : A₂ ⟶ B₂} {α : A₁ ⟶ A₂} {β : B₁ ⟶ B₂}
  (sq1 : commsq f₁ α β f₂) :
  of_hom f₁ ≫ of_hom β = of_hom α ≫ of_hom f₂ :=
begin
  have := sq1.w,
  apply_fun (λ f, (homotopy_category.quotient _ _).map f) at this,
  simp only [functor.map_comp] at this,
  exact this,
end

@[simp] lemma of_hom_id
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A : cochain_complex 𝓐 ℤ}
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A).is_bounded_above] :
  of_hom (𝟙 A) = 𝟙 _ :=
by { delta of_hom, rw [category_theory.functor.map_id], refl }

lemma Ext_iso_of_bicartesian_of_bicartesian
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐] [enough_projectives 𝓐]
  {A₁ B₁ C A₂ B₂ : cochain_complex 𝓐 ℤ}
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A₁).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj B₁).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj C).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj A₂).is_bounded_above]
  [((homotopy_category.quotient 𝓐 (complex_shape.up ℤ)).obj B₂).is_bounded_above]
  {f₁ : A₁ ⟶ B₁} {g₁ : B₁ ⟶ C} (w₁ : ∀ n, short_exact (f₁.f n) (g₁.f n))
  {f₂ : A₂ ⟶ B₂} {g₂ : B₂ ⟶ C} (w₂ : ∀ n, short_exact (f₂.f n) (g₂.f n))
  (α : A₁ ⟶ A₂) (β : B₁ ⟶ B₂) (γ : C ⟶ C)
  (ιA : A₁ ⟶ A₂) (ιB : B₁ ⟶ B₂)
  (sq1 : commsq f₁ α β f₂) (sq2 : commsq g₁ β γ g₂)
  (sq1' : commsq f₁ ιA ιB f₂) (sq2' : commsq g₁ ιB (𝟙 _) g₂)
  (V : bounded_homotopy_category 𝓐) (T_inv : V ⟶ V)
  (i : ℤ)
  (H1 : (Ext_Tinv2_commsq (of_hom α) (of_hom ιA) (of_hom β) (of_hom ιB) (of_hom f₁) (of_hom f₂)
    (auux sq1) (auux sq1') T_inv i).bicartesian)
  (H2 : (Ext_Tinv2_commsq (of_hom α) (of_hom ιA) (of_hom β) (of_hom ιB) (of_hom f₁) (of_hom f₂)
    (auux sq1) (auux sq1') T_inv (i+1)).bicartesian) :
  is_iso (Ext_Tinv2 (of_hom γ) (𝟙 _) T_inv (i+1)) :=
begin
  have LES₁ := (((Ext_five_term_exact_seq' _ _ i V w₁).drop 2).pair.cons (Ext_five_term_exact_seq' _ _ (i+1) V w₁)),
  replace LES₁ := (((Ext_five_term_exact_seq' _ _ i V w₁).drop 1).pair.cons LES₁).extract 0 4,
  have LES₂ := (((Ext_five_term_exact_seq' _ _ i V w₂).drop 2).pair.cons (Ext_five_term_exact_seq' _ _ (i+1) V w₂)).extract 0 4,
  replace LES₂ := (((Ext_five_term_exact_seq' _ _ i V w₂).drop 1).pair.cons LES₂).extract 0 4,
  refine iso_of_bicartesian_of_bicartesian LES₂ LES₁ _ _ _ _ H1 H2,
  { apply commsq.of_eq, delta Ext_Tinv2, clear LES₁ LES₂,
    rw [sub_comp, comp_sub, ← functor.flip_obj_map, ← functor.flip_obj_map],
    rw ← Ext_δ_natural i V _ _ _ _ α β γ sq1.w sq2.w w₁ w₂,
    congr' 1,
    rw [← nat_trans.naturality, ← functor.flip_obj_map, category.assoc,
      Ext_δ_natural i V _ _ _ _ ιA ιB (𝟙 _) sq1'.w sq2'.w w₁ w₂],
    simp only [op_id, category_theory.functor.map_id, nat_trans.id_app,
      category.id_comp, of_hom_id, category.comp_id],
    erw [category.id_comp],
    symmetry,
    apply Ext_δ_natural', },
  { apply Ext_Tinv2_commsq,
    { exact auux sq2 },
    { exact auux sq2' }, },
end

end


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

universes l

namespace Mathlib

/-!
# Documentation commands

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

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

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

## Implementation details

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

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

/-- A rudimentary hash function on strings. -/
def string.hash (s : string) : ℕ :=
  string.fold 1 (fun (h : ℕ) (c : char) => (bit1 (bit0 (bit0 (bit0 (bit0 1)))) * h + char.val c) % unsigned_sz) s

/-- `mk_hashed_name nspace id` hashes the string `id` to a value `i` and returns the name
`nspace._i` -/
/--
`copy_doc_string fr to` copies the docstring from the declaration named `fr`
to each declaration named in the list `to`. -/
/--
`copy_doc_string source → target_1 target_2 ... target_n` copies the doc string of the
declaration named `source` to each of `target_1`, `target_2`, ..., `target_n`.
 -/
/-! ### The `library_note` command -/

/-- A user attribute `library_note` for tagging decls of type `string × string` for use in note
output. -/
/--
`mk_reflected_definition name val` constructs a definition declaration by reflection.

Example: ``mk_reflected_definition `foo 17`` constructs the definition
declaration corresponding to `def foo : ℕ := 17`
-/
/-- If `note_name` and `note` are `pexpr`s representing strings,
`add_library_note note_name note` adds a declaration of type `string × string` and tags it with
the `library_note` attribute. -/
/--
A command to add library notes. Syntax:
```
/--
note message
-/
/-- Collects all notes in the current environment.
Returns a list of pairs `(note_id, note_content)` -/
/-! ### The `add_tactic_doc_entry` command -/

/-- The categories of tactic doc entry. -/
inductive doc_category
where
| tactic : doc_category
| cmd : doc_category
| hole_cmd : doc_category
| attr : doc_category

/-- Format a `doc_category` -/
/-- The information used to generate a tactic doc entry -/
structure tactic_doc_entry
where
  name : string
  category : doc_category
  decl_names : List name
  tags : List string
  description : string
  inherit_description_from : Option name

/-- Turns a `tactic_doc_entry` into a JSON representation. -/
/-- `update_description_from tde inh_id` replaces the `description` field of `tde` with the
    doc string of the declaration named `inh_id`. -/
/--
`update_description tde` replaces the `description` field of `tde` with:

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

If neither of these conditions are met, it returns `tde`. -/
/-- A user attribute `tactic_doc` for tagging decls of type `tactic_doc_entry`
for use in doc output -/
/-- Collects everything in the environment tagged with the attribute `tactic_doc`. -/
/-- `add_tactic_doc tde` adds a declaration to the environment
with `tde` as its body and tags it with the `tactic_doc`
attribute. If `tde.decl_names` has exactly one entry `` `decl`` and
if `tde.description` is the empty string, `add_tactic_doc` uses the doc
string of `decl` as the description. -/
/--
A command used to add documentation for a tactic, command, hole command, or attribute.

Usage: after defining an interactive tactic, command, or attribute,
add its documentation as follows.
```lean
/--
describe what the command does here
-/
/--
At various places in mathlib, we leave implementation notes that are referenced from many other
files. To keep track of these notes, we use the command `library_note`. This makes it easy to
retrieve a list of all notes, e.g. for documentation output.

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

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

/-- behavior of f -/
-- add docs to core tactics

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

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

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

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

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

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

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

* The congruence lemmas for dependent type theory as used in Lean are described in
[Congruence closure in intensional type theory](https://leanprover.github.io/papers/congr.pdf)
(de Moura, Selsam IJCAR 2016).
-/
/--
`conv {...}` allows the user to perform targeted rewriting on a goal or hypothesis,
by focusing on particular subexpressions.

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

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

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

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

Also, as a shorthand, `conv_lhs` and `conv_rhs` are provided, so that
```lean
example : 0 + 0 = 0 :=
begin
  conv_lhs { simp }
end
```
just means
```lean
example : 0 + 0 = 0 :=
begin
  conv { to_lhs, simp }
end
```
and likewise for `to_rhs`.
-/
/--
Accepts terms with the type `component tactic_state string` or `html empty` and
renders them interactively.
Requires a compatible version of the vscode extension to view the resulting widget.

### Example:

```lean
/-- A simple counter that can be incremented or decremented with some buttons. -/
/--
The `add_decl_doc` command is used to add a doc string to an existing declaration.

```lean
def foo := 5

/--
Doc string for foo.
-/


import Lean
import Verbose.Common

open Lean Parser Meta Elab Tactic Option

/- Restore rewrite using a single term without brackets. -/
declare_syntax_cat myRwRuleSeq
syntax rwRule : myRwRuleSeq
syntax "[" rwRule,*,? "]" : myRwRuleSeq

/--
We rewrite
-/
macro (name := weRewrite) rw:"We" "rewrite using" c:(config)? s:myRwRuleSeq l:(location)? : tactic =>
  match s with
  | `(myRwRuleSeq| [%$lbrak $rs:rwRule,* ]%$rbrak) =>
    -- We show the `rfl` state on `]`
    `(tactic| rewrite%$rw $(c)? [%$lbrak $rs,*] $(l)?; try (with_reducible rfl%$rbrak))
  | `(myRwRuleSeq| $rs:rwRule) =>
    `(tactic| rewrite%$rw $(c)? [$rs] $(l)?; try (with_reducible rfl))
  | _ => Macro.throwUnsupported

example (a b : Nat) (h : a = b) (h' : b = 0): a = 0 := by
  We rewrite using ← h at h'
  exact h'

def discussOr (input : Term) : TacticM Unit := do
    evalApplyLikeTactic Meta.apply <| ← `(Or.elim $input)

elab "We" "discuss using" exp:term : tactic =>
  discussOr exp

example (P Q : Prop) (h : P ∨ Q) : True := by
  We discuss using h
  . intro _hP
    trivial
  . intro _hQ
    trivial

macro "We" "discuss depending on" exp:term : tactic =>
`(tactic| We discuss using Classical.em $exp)

example (P : Prop) : True := by
  We discuss depending on P
  . intro _hP
    trivial
  . intro _hnP
    trivial


import data.list
import data.rbmap
import tactic.linarith

import .ast
import .sized

lemma rbmap_insert_lookup_eq {α:Type} {β:Type} {lt:α → α → Prop} [Hdec:decidable_rel lt]
  (m:rbmap α β lt)
  (k:α) (x:β)
  : forall a, cmp_using lt a k = ordering.eq → rbmap.find (rbmap.insert m k x) a = some x
:= sorry

lemma rbmap_insert_lookup_neq {α:Type} {β:Type} {lt:α → α → Prop} [Hdec:decidable_rel lt]
  (m:rbmap α β lt)
  (k:α) (x:β)
  : forall a, cmp_using lt a k ≠ ordering.eq → rbmap.find (rbmap.insert m k x) a = rbmap.find m a
:= sorry

namespace llvm.

meta def llvm_type_tac :=
  `[unfold has_well_founded.r measure inv_image sizeof has_sizeof.sizeof
      llvm_type.sizeof
      at *,
    try { linarith }
   ].

@[simp]
def mentions : llvm_type → list ident
| (llvm_type.prim_type _) := []
| (llvm_type.alias i) := [i]
| (llvm_type.array _n tp) := mentions tp
| (llvm_type.fun_ty ret args _va) := mentions ret ++ (list.join (sized.map_over args (λ x H, mentions x)))
| (llvm_type.ptr_to _) := [] -- NB pointer types are explicitly excluded
| (llvm_type.struct fs) := list.join (sized.map_over fs (λ x H, mentions x))
| (llvm_type.packed_struct fs) := list.join (sized.map_over fs (λ x H, mentions x))
| (llvm_type.vector _n tp) := mentions tp
| (llvm_type.opaque) := []

using_well_founded ⟨λ _ _, `[exact ⟨measure sizeof, measure_wf _⟩] , llvm_type_tac⟩
.

@[reducible,simp]
def alias_rel (am:strmap llvm_type) (x y:ident) : Prop :=
  ∃tp, am.find y.ident = some tp /\ x ∈ mentions tp.

instance ident_eq_dec : decidable_rel (@eq ident) :=
begin
  unfold decidable_rel, intros a b, cases a, cases b, simp, apply_instance
end

@[reducible]
def alias_map := { am:strmap llvm_type // (forall a, acc (alias_rel am) a) }.

namespace alias_map.

def all_mem_dec {α:Type} (p:α → Prop) (l:list α) :
  (∀x, x ∈ l → decidable (p x)) →
  decidable (∀x, x ∈ l → p x) :=
begin
  induction l,
  case list.nil {
    intros, unfold has_mem.mem list.mem,
    right; intros, trivial,
  },
  case list.cons {
    intros, unfold has_mem.mem list.mem, intros,
    cases (a l_hd (or.inl rfl)),
    { left, intro, apply h, apply a_1, simp, },
    { have Hsub : (Π (x : α), x ∈ l_tl → decidable (p x)),
      { intros; apply a, apply or.inr, assumption },
      cases (l_ih Hsub),
      { left, intro, apply h_1, intros, apply a_1, apply or.inr, assumption },
      { right, intros, cases a_1,
        { subst x; assumption },
        { apply h_1; assumption }
      }
    }
  }
end

def ex_mem_dec {α:Type} (p:α → Prop) (l:list α) :
  (∀x, x ∈ l → decidable (p x)) →
  decidable (∃x, x ∈ l ∧ p x) :=
begin
  induction l,
  case list.nil {
    intros, unfold has_mem.mem list.mem,
    left, intro H, cases H, cases H_h, trivial
  },
  case list.cons {
    intros, unfold has_mem.mem list.mem, intros,
    cases (a l_hd (or.inl rfl)),
    { have Hsub : (Π (x : α), x ∈ l_tl → decidable (p x)),
      { intros; apply a, apply or.inr, assumption },
      cases (l_ih Hsub),
      { left, intro H, cases H, cases H_h, cases H_h_left,
        { apply h; cc },
        { apply h_1, existsi H_w, cc }
      },
      { right, cases h_1, existsi h_1_w, cases h_1_h, split,
        apply or.inr, assumption, assumption,
      }
    },
    { right, existsi l_hd, split; try {assumption}, left, refl,
    }
  }
end.

def reachable_dec
  (am:strmap llvm_type)
  : forall x y (Hacc : acc (alias_rel am) y), decidable (tc (alias_rel am) x y) :=
begin
  intros x y Hacc, apply Hacc.rec_on, clear Hacc y, intros y _ IH,
  destruct (am.find y.ident),
  { intros Hy, left, intro Htc, revert Hy, clear IH,
    induction Htc,
    { intros, cases Htc_a_1, cc, },
    { intros, cc }
  },
  intros tp Htp,
  have H : decidable (∃i, i ∈ mentions tp ∧ (i = x ∨ tc (alias_rel am) x i)),
  { apply ex_mem_dec, intros i Hi,
    cases (llvm.ident_eq_dec i x),
    { have Hi : alias_rel am i y, { existsi tp, split; assumption },
      cases (IH i Hi),
      { left, intro H, cases H; cc },
      { right, right, assumption }
    },
    { right, left, assumption },
  },

  cases H,
  { left, intro, clear h IH, apply H, clear H,
    induction a; intros,
    unfold alias_rel at a_a_1, cases a_a_1 with tp' Ha, cases Ha with Ha1 Ha2,
    have Heq : tp = tp', { cc }, subst tp',
    existsi a_a, split, apply Ha2, simp,
    cases (a_ih_a_1 Htp),
    cases h, cases h_right, subst a_b,
    existsi w, split, assumption, right, assumption,
    existsi w, split, assumption, right, apply tc.trans _ a_b _; assumption,
  },
  { right, cases H with i H, cases H with H1 H2, cases H2 with H2 H2,
    subst i, apply tc.base, existsi tp, split; assumption,
    apply tc.trans _ i _, assumption, apply tc.base, existsi tp, split; assumption
  }
end.

lemma string_cmp_using_eq
  (x y : string) :
  cmp_using string.has_lt'.lt x y = ordering.eq → x = y :=
begin
  unfold cmp_using ite,
  cases (string.decidable_lt y x); simp,
  cases (string.decidable_lt x y); simp,
  apply le_antisymm; assumption,
  cases (string.decidable_lt x y); simp,
end.

lemma insert_alias_map_wf_aux
  (am:strmap llvm_type)
  (x z:ident) (tp:llvm_type)
  (Hacc: acc (alias_rel am) z)
  : forall
  (Hxy : z ≠ x)
  (Hntc: ¬(tc (alias_rel am) x z)),
  acc (alias_rel (rbmap.insert am x.ident tp)) z :=
begin
  apply Hacc.rec_on, clear Hacc z, intros z h IH Hx Htc,
  apply acc.intro, intros q Hq,
  cases Hq with tp Htp, cases Htp with Htp1 Htp2,
  rewrite (rbmap_insert_lookup_neq am) at Htp1,
  { apply IH,
    { existsi tp, cc },
    { intro Hqx, apply Htc, apply tc.base,
      subst q, existsi tp, cc
    },
    { intro Hxq, apply Htc,
      apply tc.trans _ q _, assumption,
      apply tc.base, existsi tp, cc,
    }
  },
  { intro, apply Hx, cases z, cases x,
    unfold ident.ident at a,
    have Hzx : z = x, { apply string_cmp_using_eq, assumption },
    cc
  }
end

lemma insert_alias_map_wf
  (am:strmap llvm_type)
  (x:ident) (tp:llvm_type)
  (Hacc: forall a, acc (alias_rel am) a)
  (Hnacc : ¬∃y, y ∈ mentions tp ∧ (y = x ∨ tc (alias_rel am) x y))
  : forall a, acc (alias_rel (rbmap.insert am x.ident tp)) a :=
begin
  intro a, apply (Hacc a).rec_on, clear a, intros a h IH, clear h,
  apply acc.intro, intros q Hq,
  cases Hq with tp' Htp, cases Htp with Htp1 Htp2,
  apply (@decidable.by_cases (cmp_using string.has_lt'.lt a.ident x.ident = ordering.eq)); intro Heq,
  { rewrite (rbmap_insert_lookup_eq am x.ident tp) at Htp1; try {assumption},
    injection Htp1, subst tp', clear Htp1,
    apply (insert_alias_map_wf_aux am x q tp (Hacc q)),
    { intro; subst q, apply Hnacc, existsi x, cc, },
    { intro, apply Hnacc, existsi q, cc, }
  },
  { rewrite (rbmap_insert_lookup_neq am x.ident tp) at Htp1; try {assumption},
    apply (IH q), existsi tp', split; assumption
  }
end.

def empty : alias_map := subtype.mk (strmap_empty _)
  begin
    intro a, apply acc.intro, intros b H,
    destruct H, simp, unfold strmap_empty,
    unfold rbmap.find rbmap.find_entry rbmap.from_list,
    unfold mk_rbmap mk_rbtree,
    simp, unfold rbmap.find_entry._match_1 rbmap.to_value,
    intros, cc,
  end
.

def insert_check_dec (am:alias_map) (x:ident) (tp:llvm_type) :
  decidable (∃y, y ∈ mentions tp ∧ (y = x ∨ tc (alias_rel am.val) x y)) :=
begin
  apply ex_mem_dec, intros q Hq,
  cases (llvm.ident_eq_dec q x),
  { cases (reachable_dec am.val x q (am.property q)),
    { left, intro H; cases H; cc },
    { right, right, assumption }
  },
  { right, left, assumption }
end.

def insert (am:alias_map) (k:ident) (tp:llvm_type) : option alias_map :=
  match insert_check_dec am k tp with
  | decidable.is_true _ := none
  | decidable.is_false H :=
      some ⟨rbmap.insert am.val k.ident tp, insert_alias_map_wf am.val k tp am.property H⟩
  end

def build : list type_decl → alias_map → sum type_decl alias_map
| []        am := sum.inr am
| (td::tds) am :=
    match insert am td.name td.value with
    | none        := sum.inl td
    | some am'    := build tds am'
    end.

end alias_map.

end llvm.


import Lean
import Mathlib.Tactic.RCases
import Mathlib.Init.ExtendedBinder

import Verbose.Common

inductive intro_rel where
| lt | gt | le | ge | mem
deriving Repr

open Lean

inductive introduced where
| typed (syn : Syntax) (n : Name) (e : Syntax) : introduced
| bare (syn : Syntax) (n : Name) : introduced
| related (syn : Syntax) (n : Name) (rel : intro_rel) (e : Syntax) : introduced
deriving Repr

open Lean Meta
open Lean Elab Tactic

/- Like Lean.Meta.intro except it introduces only data and fails on Prop.
It takes the current goal id as `mvarId` and a name for the newly introduced object
and returns a `FVarId` referring the newly introduced object and a `MVarId` for the new
goal.
 -/
def introObj (mvarId : MVarId) (name : Name) : MetaM (FVarId × MVarId) := do
  let tgt ← whnf (← getMVarType mvarId)
  if tgt.isForall ∨ tgt.isLet then
    let (fvar, newmvarId) ← intro mvarId name
    withMVarContext newmvarId do
      let t := (← getLocalDecl fvar).type
      if (← inferType t).isProp then
        throwError "There is no object to introduce here."
      else
        pure (fvar, newmvarId)
  else
    throwError "There is no object to introduce here."

def Fix1 : introduced → TacticM Unit
| introduced.typed syn n t   =>  do
  withRef syn do
    checkName n
    -- Introduce n, getting the corresponding FVarId and the new goal MVarId with its context
    let (n_fvar, new_goal) ← introObj (← getMainGoal) n
    -- Change the default MVarContext to the newly created one for the benefit of `elabTerm`
    withMVarContext new_goal do
      replaceMainGoal [← changeLocalDecl new_goal n_fvar (← elabTerm t none)]
| introduced.bare syn n      => do
  withRef syn do
    checkName n
    -- Introduce n, forget the corresponding FVarId and get the new goal MVarId with its context
    let (_, new_goal) ← introObj (← getMainGoal) n
    replaceMainGoal [new_goal]
| introduced.related syn n rel e => do
  withRef syn do
    checkName n
    let (n_fvar, new_goal) ← introObj (← getMainGoal) n
    withMVarContext new_goal do
      let n_decl ← getLocalDeclFromUserName n
      let n_type := n_decl.type
      -- Let's build the RHS e as an expr. In the membership case we don't have extra information
      -- in other case we elaborate knowing we should get the same type as n
      let (E : Expr) ← match rel with
              | intro_rel.mem => elabTerm e none
              | _ => elabTerm e n_type
      -- Now create a name for the relation assumption that will be created
      let (hyp_name : String) := if e matches `(0) then
                        match rel with
                        | intro_rel.lt  => n.toString ++ "_neg"
                        | intro_rel.gt  => n.toString ++ "_pos"
                        | intro_rel.le  => n.toString ++ "_neg"
                        | intro_rel.ge  => n.toString ++ "_pos"
                        | intro_rel.mem => "h_" ++ n.toString -- shouldn't happen

                      else
                        match rel with
                        | intro_rel.lt  => n.toString ++ "_lt"
                        | intro_rel.gt  => n.toString ++ "_gt"
                        | intro_rel.le  => n.toString ++ "_le"
                        | intro_rel.ge  => n.toString ++ "_ge"
                        | intro_rel.mem => n.toString ++ "_mem"

      let n_expr : Expr := mkFVar n_fvar
      let (rel_expr : Expr) ← match rel with
                    | intro_rel.lt => mkAppM ``LT.lt #[n_expr, E]
                    | intro_rel.gt => mkAppM ``GT.gt #[n_expr, E]
                    | intro_rel.le => mkAppM ``LE.le #[n_expr, E]
                    | intro_rel.ge => mkAppM ``GE.ge #[n_expr, E]
                    | intro_rel.mem => mkAppM ``Membership.mem #[n_expr, E]

      let (hyp_fvar, newer_goal) ← intro new_goal hyp_name
      withMVarContext newer_goal do
        let new_mvarid ← changeLocalDecl newer_goal hyp_fvar rel_expr
        replaceMainGoal [new_mvarid]

section
open Lean Elab

declare_syntax_cat fixDecl
syntax ident : fixDecl
syntax ident ":" term : fixDecl
syntax ident "<" term : fixDecl
syntax ident ">" term : fixDecl
syntax ident ("<=" <|> "≤") term : fixDecl
syntax ident (">=" <|> "≥") term : fixDecl
syntax ident "∈" term : fixDecl
syntax "(" fixDecl ")" : fixDecl

syntax "Fix₁ " colGt fixDecl : tactic
syntax "Fix " (colGt fixDecl)+ : tactic

elab_rules : tactic
  | `(tactic| Fix₁ $x:ident) => Fix1 (introduced.bare x x.getId)

elab_rules : tactic
  | `(tactic| Fix₁ $x:ident : $type) =>
    Fix1 (introduced.typed (mkNullNode #[x, type]) x.getId type)

elab_rules : tactic
  | `(tactic| Fix₁ $x:ident < $bound) =>
    Fix1 (introduced.related (mkNullNode #[x, bound]) x.getId intro_rel.lt bound)

elab_rules : tactic
  | `(tactic| Fix₁ $x:ident > $bound) =>
    Fix1 (introduced.related (mkNullNode #[x, bound]) x.getId intro_rel.gt bound)

elab_rules : tactic
  | `(tactic| Fix₁ $x:ident ≤ $bound) =>
    Fix1 (introduced.related (mkNullNode #[x, bound]) x.getId intro_rel.le bound)

elab_rules : tactic
  | `(tactic| Fix₁ $x:ident ≥ $bound) =>
    Fix1 (introduced.related (mkNullNode #[x, bound]) x.getId intro_rel.ge bound)

elab_rules : tactic
  | `(tactic| Fix₁ $x:ident ∈ $set) =>
    Fix1 (introduced.related (mkNullNode #[x, set]) x.getId intro_rel.mem set)

elab_rules : tactic
  | `(tactic| Fix₁ ( $decl:fixDecl )) => do evalTactic (← `(tactic| Fix₁ $decl:fixDecl))

macro_rules
  | `(tactic| Fix $decl:fixDecl) => `(tactic| Fix₁ $decl)

macro_rules
  | `(tactic| Fix $decl:fixDecl $decls:fixDecl*) => `(tactic| Fix₁ $decl; Fix $decls:fixDecl*)

macro_rules
| `(ℕ) => `(Nat)

-- requires the extended binder import
#check ∀ n ≥ 2, true

#check ∃ n ≥ 2, true

example : ∀ b : ℕ, ∀ a : Nat, a ≥ 2 → a = a ∧ b = b := by
  Fix b (a ≥ 2)
  trivial

end


import tactic
import category_theory.limits.shapes.pullbacks

namespace category_theory
open category_theory.limits

variables {C D : Type*} [category C] [category D] (e : C ≌ D)
  {X Y B : D} (f : X ⟶ B) (g : Y ⟶ B) [has_pullback (e.inverse.map f) (e.inverse.map g)]

lemma equivalence.hom_eq_map {X Y : C} (f : e.functor.obj X ⟶ e.functor.obj Y)
  (g : X ⟶ Y) : e.inverse.map f = e.symm.counit.app _ ≫ g ≫ e.unit.app _ →
  f = e.functor.map g :=
begin
  intros h,
  change _ = (e.unit_iso.app _).inv ≫ g ≫ (e.unit_iso.app _).hom at h,
  rw iso.eq_inv_comp at h,
  replace h := h.symm,
  rw ← iso.eq_comp_inv at h,
  rw h,
  simp,
  nth_rewrite 0 ← category.id_comp f,
  simp_rw ← category.assoc,
  congr' 1,
  simp,
end

noncomputable theory

/-
I would like to do something for more general shapes, but universes make this difficult
(as usual...)
-/

@[simps]
def equivalence.pullback_cone : cone (cospan f g) :=
{ X := e.functor.obj $ pullback (e.inverse.map f) (e.inverse.map g),
  π :=
  { app := λ i,
    match i with
    | none := e.functor.map pullback.fst ≫ e.counit.app X ≫ f
    | walking_cospan.left := e.functor.map pullback.fst ≫ e.counit.app X
    | walking_cospan.right := e.functor.map pullback.snd ≫ e.counit.app Y
    end,
    naturality' := begin
      rintro (i|i|i) (j|j|j) (h|h),
      { tidy },
      { tidy },
      { tidy },
      { unfold_aux,
        dsimp, simp, delta id_rhs,
        have : e.counit.app X ≫ f = e.functor.map (e.inverse.map f) ≫ e.counit.app B, by tidy,
        rw this, clear this,
        have : e.counit.app Y ≫ g = e.functor.map (e.inverse.map g) ≫ e.counit.app B, by tidy,
        rw this, clear this,
        simp_rw [← category.assoc, ← e.functor.map_comp, limits.pullback.condition] },
      { tidy }
    end } } .

-- This is a mess :-(
-- Please fix before moving this file to mathlib!
def equivalence.is_limit_pullback_cone : limits.is_limit (e.pullback_cone f g) :=
{ lift := λ S, e.symm.unit.app S.X ≫
    e.functor.map (pullback.lift (e.inverse.map (S.π.app walking_cospan.left))
      (e.inverse.map (S.π.app walking_cospan.right)) begin
        simp_rw ← e.inverse.map_comp,
        congr' 1,
        have := cospan_map_inl f g,
        change _ ≫ (cospan f g).map walking_cospan.hom.inl =
          _ ≫ (cospan f g).map walking_cospan.hom.inr,
        simp_rw S.w,
      end),
  fac' := begin
    rintros S (j|j|j),
    { dsimp [equivalence.pullback_cone._match_1], simp,
      have : e.counit.app X ≫ f = e.functor.map (e.inverse.map f) ≫ e.counit.app B, by tidy,
      rw this, clear this,
      simp_rw [← category.assoc _ _ (e.counit.app B), ← e.functor.map_comp],
      simp,
      dsimp,
      simp,
      change _ ≫ (cospan f g).map walking_cospan.hom.inl = _,
      rw S.w },
    { dsimp [equivalence.pullback_cone._match_1], simp,
      simp_rw [← category.assoc _ _ (e.counit.app X), ← e.functor.map_comp],
      simp,
      dsimp,
      simp },
    { dsimp [equivalence.pullback_cone._match_1], simp,
      simp_rw [← category.assoc _ _ (e.counit.app Y), ← e.functor.map_comp],
      simp,
      dsimp,
      simp }
  end,
  uniq' := begin
    intros S m h,
    dsimp at *,
    change m = (e.counit_iso.app S.X).inv ≫ _,
    rw iso.eq_inv_comp,
    apply equivalence.hom_eq_map,
    change _ = (e.unit_iso.app _).inv ≫ _ ≫ (e.unit_iso.app _).hom,
    rw iso.eq_inv_comp,
    symmetry,
    rw ← iso.eq_comp_inv,
    simp,
    apply pullback.hom_ext,
    { simp,
      specialize h walking_cospan.left,
      dsimp [equivalence.pullback_cone._match_1] at h,
      rw ← h,
      simp,
      simp_rw ← category.assoc,
      congr' 2,
      simp },
    { simp,
      specialize h walking_cospan.right,
      dsimp [equivalence.pullback_cone._match_1] at h,
      rw ← h,
      simp,
      simp_rw ← category.assoc,
      congr' 2,
      simp }
  end } .

include e

lemma equivalence.has_pullback {X Y B : D} (f : X ⟶ B) (g : Y ⟶ B)
  [has_pullback (e.inverse.map f) (e.inverse.map g)] : has_pullback f g :=
limits.has_limit.mk ⟨e.pullback_cone _ _, e.is_limit_pullback_cone _ _⟩

lemma equivalence.has_pullbacks [has_pullbacks C] : has_pullbacks D :=
begin
  apply has_pullbacks_of_has_limit_cospan _,
  intros X Y B f g,
  apply e.has_pullback,
end

end category_theory


import .cofibration_category
import .cylinder
import .lifting

universes v u

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

namespace homotopy_theory.cofibrations
open precofibration_category cofibration_category

variables {C : Type u} [category.{v} C] [cofibration_category.{v} C]

-- Homotopies in a cofibration category.

variables {a b : C} {j : a ⟶ b} {hj : is_cof j}

structure homotopy_on (c : relative_cylinder hj) {x : C} (f₀ f₁ : b ⟶ x) :=
(H : c.ob ⟶ x)
(Hi₀ : H ∘ c.i₀ = f₀)
(Hi₁ : H ∘ c.i₁ = f₁)

@[ext] lemma homotopy_on.ext (c : relative_cylinder hj) {x : C} (f₀ f₁ : b ⟶ x)
  (H H' : homotopy_on c f₀ f₁) (e : H.H = H'.H) : H = H' :=
by cases H; cases H'; simpa

def homotopy_on.refl {c : relative_cylinder hj} {x : C} (f : b ⟶ x) :
  homotopy_on c f f :=
⟨f ∘ c.p, by rw [←assoc, c.pi₀]; simp, by rw [←assoc, c.pi₁]; simp⟩

def homotopy_on.symm {c : relative_cylinder hj} {x : C} {f₀ f₁ : b ⟶ x} :
  homotopy_on c f₀ f₁ → homotopy_on c.reverse f₁ f₀ :=
λ H, ⟨H.H, by convert H.Hi₁; simp, by convert H.Hi₀; simp⟩

def homotopy_on.trans {c₀ c₁ : relative_cylinder hj} {x : C} {f₀ f₁ f₂ : b ⟶ x} :
  homotopy_on c₀ f₀ f₁ → homotopy_on c₁ f₁ f₂ → homotopy_on (c₀.glue c₁) f₀ f₂ :=
λ H₀ H₁,
⟨(pushout_by_cof c₀.i₁ c₁.i₀ c₀.acof_i₁.1).is_pushout.induced
  H₀.H H₁.H (H₀.Hi₁.trans H₁.Hi₀.symm),
 by convert H₀.Hi₀ using 1; simp, by convert H₁.Hi₁ using 1; simp⟩

-- Two maps f₀, f₁ are homotopic rel j with respect to a chosen
-- cylinder object on j if there exists a homotopy from f₀ to f₁
-- defined on that cylinder.
def homotopic_wrt (c : relative_cylinder hj) {x : C} (f₀ f₁ : b ⟶ x) : Prop :=
nonempty (homotopy_on c f₀ f₁)

-- If x is fibrant, then any two cylinders define the same homotopy
-- rel j relation on maps b ⟶ x.
lemma homotopic_iff_of_embedding {c c' : relative_cylinder hj}
  (m : cylinder_embedding c c') {x : C} (hx : fibrant x) (f₀ f₁ : b ⟶ x) :
  homotopic_wrt c f₀ f₁ ↔ homotopic_wrt c' f₀ f₁ :=
iff.intro
  (assume ⟨⟨H, Hi₀, Hi₁⟩⟩,
    let ⟨H', hH'⟩ := fibrant_iff_rlp.mp hx m.acof_k H in
    ⟨⟨H', by rw ←m.hki₀; simp [hH', Hi₀], by rw ←m.hki₁; simp [hH', Hi₁]⟩⟩)
  (assume ⟨⟨H, Hi₀, Hi₁⟩⟩,
    ⟨⟨H ∘ m.k, by rw [←assoc, m.hki₀, Hi₀], by rw [←assoc, m.hki₁, Hi₁]⟩⟩)

lemma homotopic_iff (c₀ c₁ : relative_cylinder hj) {x : C} (hx : fibrant x) (f₀ f₁ : b ⟶ x) :
  homotopic_wrt c₀ f₀ f₁ ↔ homotopic_wrt c₁ f₀ f₁ :=
let ⟨⟨c', m₀, m₁⟩⟩ := exists_common_embedding c₀ c₁ in
(homotopic_iff_of_embedding m₀ hx f₀ f₁).trans
  (homotopic_iff_of_embedding m₁ hx f₀ f₁).symm

variables (hj)
def homotopic_rel {x} (f₀ f₁ : b ⟶ x) : Prop :=
∃ c : relative_cylinder hj, homotopic_wrt c f₀ f₁

variables {hj}
lemma homotopic_rel' (c : relative_cylinder hj) {x} (hx : fibrant x) (f₀ f₁ : b ⟶ x)
  (h : homotopic_rel hj f₀ f₁) : homotopic_wrt c f₀ f₁ :=
let ⟨c', hw⟩ := h in (homotopic_iff c' c hx f₀ f₁).mp hw

@[refl] lemma homotopic_rel.refl {x} (f : b ⟶ x) : homotopic_rel hj f f :=
let ⟨c⟩ := exists_relative_cylinder hj in
⟨c, ⟨homotopy_on.refl f⟩⟩

@[symm] lemma homotopic_rel.symm {x} {f₀ f₁ : b ⟶ x} :
  homotopic_rel hj f₀ f₁ → homotopic_rel hj f₁ f₀ :=
assume ⟨c, ⟨H⟩⟩, ⟨c.reverse, ⟨homotopy_on.symm H⟩⟩

@[trans] lemma homotopic_rel.trans {x} {f₀ f₁ f₂ : b ⟶ x} :
  homotopic_rel hj f₀ f₁ → homotopic_rel hj f₁ f₂ → homotopic_rel hj f₀ f₂ :=
assume ⟨c₀, ⟨H₀⟩⟩ ⟨c₁, ⟨H₁⟩⟩,
⟨c₀.glue c₁, ⟨H₀.trans H₁⟩⟩

lemma homotopic_rel_is_equivalence {x : C} :
  equivalence (homotopic_rel hj : (b ⟶ x) → (b ⟶ x) → Prop) :=
⟨homotopic_rel.refl,
 λ f₀ f₁, homotopic_rel.symm,
 λ f₀ f₁ f₂, homotopic_rel.trans⟩

notation f₀ ` ≃ `:50 f₁:50 ` rel `:50 hj:50 := homotopic_rel hj f₀ f₁

variables (hj)
def homotopic_rel_setoid (x : C) : setoid (b ⟶ x) :=
{ r := λ f₀ f₁, homotopic_rel hj f₀ f₁,
  iseqv := homotopic_rel_is_equivalence }

def homotopy_class_rel (x : C) : Type v :=
quotient (homotopic_rel_setoid hj x)

-- Lifts are unique up to homotopy.
-- TODO: Useful?
lemma lifts_unique (hj : is_acof j) {x : C} (hx : fibrant x) (f : a ⟶ x)
  {g₀ g₁ : b ⟶ x} (hg₀ : g₀ ∘ j = f) (hg₁ : g₁ ∘ j = f) : g₀ ≃ g₁ rel hj.1 :=
let ⟨c⟩ := exists_relative_cylinder hj.1,
    ⟨H, h⟩ := fibrant_iff_rlp.mp hx (c.acof_ii hj.2)
      ((pushout_by_cof j j hj.1).is_pushout.induced g₀ g₁ (hg₀.trans hg₁.symm)) in
⟨c, ⟨⟨H, by simp [relative_cylinder.i₀, h], by simp [relative_cylinder.i₁, h]⟩⟩⟩

section congr_left
variables {x y : C} (g : x ⟶ y)

def homotopy_on.congr_left {c : relative_cylinder hj} {f₀ f₁ : b ⟶ x} :
  homotopy_on c f₀ f₁ → homotopy_on c (g ∘ f₀) (g ∘ f₁) :=
λ H, ⟨g ∘ H.H, by rw [←assoc, H.Hi₀], by rw [←assoc, H.Hi₁]⟩

lemma homotopic_rel.congr_left {f₀ f₁ : b ⟶ x} :
  homotopic_rel hj f₀ f₁ → homotopic_rel hj (g ∘ f₀) (g ∘ f₁) :=
λ ⟨c, ⟨H⟩⟩, ⟨c, ⟨H.congr_left hj g⟩⟩

end congr_left

section congr_right
variables {a' b' : C} {j' : a' ⟶ b'} (hj' : is_cof j')

lemma homotopic_rel.congr_right (h : pair_map hj' hj) {x : C} (hx : fibrant x)
  (f₀ f₁ : b ⟶ x) : f₀ ≃ f₁ rel hj → f₀ ∘ h.h ≃ f₁ ∘ h.h rel hj' :=
assume ⟨c, H⟩,
let ⟨c'⟩ := exists_relative_cylinder hj',
    ⟨c'', m', m, ⟨⟩⟩ := exists_of_pair_map h c' c,
    ⟨H'⟩ := (homotopic_iff_of_embedding m hx f₀ f₁).mp H in
⟨c',
 ⟨⟨H'.H ∘ m'.k,
   by rw [←assoc, m'.hki₀, assoc, H'.Hi₀],
   by rw [←assoc, m'.hki₁, assoc, H'.Hi₁]⟩⟩⟩

end congr_right

end homotopy_theory.cofibrations