/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.limits
import Mathlib.category_theory.limits.shapes.terminal
import Mathlib.category_theory.discrete_category
import Mathlib.category_theory.epi_mono
import Mathlib.PostPort

universes v l u_1 u_2 u u₂

namespace Mathlib

/-!
# Binary (co)products

We define a category `walking_pair`, which is the index category
for a binary (co)product diagram. A convenience method `pair X Y`
constructs the functor from the walking pair, hitting the given objects.

We define `prod X Y` and `coprod X Y` as limits and colimits of such functors.

Typeclasses `has_binary_products` and `has_binary_coproducts` assert the existence
of (co)limits shaped as walking pairs.

We include lemmas for simplifying equations involving projections and coprojections, and define
braiding and associating isomorphisms, and the product comparison morphism.

## References
* [Stacks: Products of pairs](https://stacks.math.columbia.edu/tag/001R)
* [Stacks: coproducts of pairs](https://stacks.math.columbia.edu/tag/04AN)
-/

namespace category_theory.limits

/-- The type of objects for the diagram indexing a binary (co)product. -/
inductive walking_pair
where
| left : walking_pair
| right : walking_pair

/--
The equivalence swapping left and right.
-/
def walking_pair.swap : walking_pair ≃ walking_pair :=
  equiv.mk (fun (j : walking_pair) => walking_pair.rec_on j walking_pair.right walking_pair.left)
    (fun (j : walking_pair) => walking_pair.rec_on j walking_pair.right walking_pair.left) sorry sorry

@[simp] theorem walking_pair.swap_apply_left : coe_fn walking_pair.swap walking_pair.left = walking_pair.right :=
  rfl

@[simp] theorem walking_pair.swap_apply_right : coe_fn walking_pair.swap walking_pair.right = walking_pair.left :=
  rfl

@[simp] theorem walking_pair.swap_symm_apply_tt : coe_fn (equiv.symm walking_pair.swap) walking_pair.left = walking_pair.right :=
  rfl

@[simp] theorem walking_pair.swap_symm_apply_ff : coe_fn (equiv.symm walking_pair.swap) walking_pair.right = walking_pair.left :=
  rfl

/--
An equivalence from `walking_pair` to `bool`, sometimes useful when reindexing limits.
-/
def walking_pair.equiv_bool : walking_pair ≃ Bool :=
  equiv.mk (fun (j : walking_pair) => walking_pair.rec_on j tt false)
    (fun (b : Bool) => bool.rec_on b walking_pair.right walking_pair.left) sorry sorry

@[simp] theorem walking_pair.equiv_bool_apply_left : coe_fn walking_pair.equiv_bool walking_pair.left = tt :=
  rfl

@[simp] theorem walking_pair.equiv_bool_apply_right : coe_fn walking_pair.equiv_bool walking_pair.right = false :=
  rfl

@[simp] theorem walking_pair.equiv_bool_symm_apply_tt : coe_fn (equiv.symm walking_pair.equiv_bool) tt = walking_pair.left :=
  rfl

@[simp] theorem walking_pair.equiv_bool_symm_apply_ff : coe_fn (equiv.symm walking_pair.equiv_bool) false = walking_pair.right :=
  rfl

/-- The diagram on the walking pair, sending the two points to `X` and `Y`. -/
def pair {C : Type u} [category C] (X : C) (Y : C) : discrete walking_pair ⥤ C :=
  discrete.functor fun (j : walking_pair) => walking_pair.cases_on j X Y

@[simp] theorem pair_obj_left {C : Type u} [category C] (X : C) (Y : C) : functor.obj (pair X Y) walking_pair.left = X :=
  rfl

@[simp] theorem pair_obj_right {C : Type u} [category C] (X : C) (Y : C) : functor.obj (pair X Y) walking_pair.right = Y :=
  rfl

/-- The natural transformation between two functors out of the walking pair, specified by its components. -/
def map_pair {C : Type u} [category C] {F : discrete walking_pair ⥤ C} {G : discrete walking_pair ⥤ C} (f : functor.obj F walking_pair.left ⟶ functor.obj G walking_pair.left) (g : functor.obj F walking_pair.right ⟶ functor.obj G walking_pair.right) : F ⟶ G :=
  nat_trans.mk fun (j : discrete walking_pair) => walking_pair.cases_on j f g

@[simp] theorem map_pair_left {C : Type u} [category C] {F : discrete walking_pair ⥤ C} {G : discrete walking_pair ⥤ C} (f : functor.obj F walking_pair.left ⟶ functor.obj G walking_pair.left) (g : functor.obj F walking_pair.right ⟶ functor.obj G walking_pair.right) : nat_trans.app (map_pair f g) walking_pair.left = f :=
  rfl

@[simp] theorem map_pair_right {C : Type u} [category C] {F : discrete walking_pair ⥤ C} {G : discrete walking_pair ⥤ C} (f : functor.obj F walking_pair.left ⟶ functor.obj G walking_pair.left) (g : functor.obj F walking_pair.right ⟶ functor.obj G walking_pair.right) : nat_trans.app (map_pair f g) walking_pair.right = g :=
  rfl

/-- The natural isomorphism between two functors out of the walking pair, specified by its components. -/
def map_pair_iso {C : Type u} [category C] {F : discrete walking_pair ⥤ C} {G : discrete walking_pair ⥤ C} (f : functor.obj F walking_pair.left ≅ functor.obj G walking_pair.left) (g : functor.obj F walking_pair.right ≅ functor.obj G walking_pair.right) : F ≅ G :=
  nat_iso.of_components (fun (j : discrete walking_pair) => walking_pair.cases_on j f g) sorry

/-- Every functor out of the walking pair is naturally isomorphic (actually, equal) to a `pair` -/
@[simp] theorem diagram_iso_pair_inv_app {C : Type u} [category C] (F : discrete walking_pair ⥤ C) (X : discrete walking_pair) : nat_trans.app (iso.inv (diagram_iso_pair F)) X =
  iso.inv
    (walking_pair.rec (iso.refl (functor.obj F walking_pair.left)) (iso.refl (functor.obj F walking_pair.right)) X) :=
  Eq.refl
    (iso.inv
      (walking_pair.rec (iso.refl (functor.obj F walking_pair.left)) (iso.refl (functor.obj F walking_pair.right)) X))

/-- The natural isomorphism between `pair X Y ⋙ F` and `pair (F.obj X) (F.obj Y)`. -/
def pair_comp {C : Type u} [category C] {D : Type u} [category D] (X : C) (Y : C) (F : C ⥤ D) : pair X Y ⋙ F ≅ pair (functor.obj F X) (functor.obj F Y) :=
  diagram_iso_pair (pair X Y ⋙ F)

/-- A binary fan is just a cone on a diagram indexing a product. -/
def binary_fan {C : Type u} [category C] (X : C) (Y : C) :=
  cone (pair X Y)

/-- The first projection of a binary fan. -/
def binary_fan.fst {C : Type u} [category C] {X : C} {Y : C} (s : binary_fan X Y) : functor.obj (functor.obj (functor.const (discrete walking_pair)) (cone.X s)) walking_pair.left ⟶
  functor.obj (pair X Y) walking_pair.left :=
  nat_trans.app (cone.π s) walking_pair.left

/-- The second projection of a binary fan. -/
def binary_fan.snd {C : Type u} [category C] {X : C} {Y : C} (s : binary_fan X Y) : functor.obj (functor.obj (functor.const (discrete walking_pair)) (cone.X s)) walking_pair.right ⟶
  functor.obj (pair X Y) walking_pair.right :=
  nat_trans.app (cone.π s) walking_pair.right

@[simp] theorem binary_fan.π_app_left {C : Type u} [category C] {X : C} {Y : C} (s : binary_fan X Y) : nat_trans.app (cone.π s) walking_pair.left = binary_fan.fst s :=
  rfl

@[simp] theorem binary_fan.π_app_right {C : Type u} [category C] {X : C} {Y : C} (s : binary_fan X Y) : nat_trans.app (cone.π s) walking_pair.right = binary_fan.snd s :=
  rfl

theorem binary_fan.is_limit.hom_ext {C : Type u} [category C] {W : C} {X : C} {Y : C} {s : binary_fan X Y} (h : is_limit s) {f : W ⟶ cone.X s} {g : W ⟶ cone.X s} (h₁ : f ≫ binary_fan.fst s = g ≫ binary_fan.fst s) (h₂ : f ≫ binary_fan.snd s = g ≫ binary_fan.snd s) : f = g :=
  is_limit.hom_ext h fun (j : discrete walking_pair) => walking_pair.cases_on j h₁ h₂

/-- A binary cofan is just a cocone on a diagram indexing a coproduct. -/
def binary_cofan {C : Type u} [category C] (X : C) (Y : C) :=
  cocone (pair X Y)

/-- The first inclusion of a binary cofan. -/
def binary_cofan.inl {C : Type u} [category C] {X : C} {Y : C} (s : binary_cofan X Y) : functor.obj (pair X Y) walking_pair.left ⟶
  functor.obj (functor.obj (functor.const (discrete walking_pair)) (cocone.X s)) walking_pair.left :=
  nat_trans.app (cocone.ι s) walking_pair.left

/-- The second inclusion of a binary cofan. -/
def binary_cofan.inr {C : Type u} [category C] {X : C} {Y : C} (s : binary_cofan X Y) : functor.obj (pair X Y) walking_pair.right ⟶
  functor.obj (functor.obj (functor.const (discrete walking_pair)) (cocone.X s)) walking_pair.right :=
  nat_trans.app (cocone.ι s) walking_pair.right

@[simp] theorem binary_cofan.ι_app_left {C : Type u} [category C] {X : C} {Y : C} (s : binary_cofan X Y) : nat_trans.app (cocone.ι s) walking_pair.left = binary_cofan.inl s :=
  rfl

@[simp] theorem binary_cofan.ι_app_right {C : Type u} [category C] {X : C} {Y : C} (s : binary_cofan X Y) : nat_trans.app (cocone.ι s) walking_pair.right = binary_cofan.inr s :=
  rfl

theorem binary_cofan.is_colimit.hom_ext {C : Type u} [category C] {W : C} {X : C} {Y : C} {s : binary_cofan X Y} (h : is_colimit s) {f : cocone.X s ⟶ W} {g : cocone.X s ⟶ W} (h₁ : binary_cofan.inl s ≫ f = binary_cofan.inl s ≫ g) (h₂ : binary_cofan.inr s ≫ f = binary_cofan.inr s ≫ g) : f = g :=
  is_colimit.hom_ext h fun (j : discrete walking_pair) => walking_pair.cases_on j h₁ h₂

/-- A binary fan with vertex `P` consists of the two projections `π₁ : P ⟶ X` and `π₂ : P ⟶ Y`. -/
def binary_fan.mk {C : Type u} [category C] {X : C} {Y : C} {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) : binary_fan X Y :=
  cone.mk P (nat_trans.mk fun (j : discrete walking_pair) => walking_pair.cases_on j π₁ π₂)

/-- A binary cofan with vertex `P` consists of the two inclusions `ι₁ : X ⟶ P` and `ι₂ : Y ⟶ P`. -/
def binary_cofan.mk {C : Type u} [category C] {X : C} {Y : C} {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) : binary_cofan X Y :=
  cocone.mk P (nat_trans.mk fun (j : discrete walking_pair) => walking_pair.cases_on j ι₁ ι₂)

@[simp] theorem binary_fan.mk_π_app_left {C : Type u} [category C] {X : C} {Y : C} {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) : nat_trans.app (cone.π (binary_fan.mk π₁ π₂)) walking_pair.left = π₁ :=
  rfl

@[simp] theorem binary_fan.mk_π_app_right {C : Type u} [category C] {X : C} {Y : C} {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) : nat_trans.app (cone.π (binary_fan.mk π₁ π₂)) walking_pair.right = π₂ :=
  rfl

@[simp] theorem binary_cofan.mk_ι_app_left {C : Type u} [category C] {X : C} {Y : C} {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) : nat_trans.app (cocone.ι (binary_cofan.mk ι₁ ι₂)) walking_pair.left = ι₁ :=
  rfl

@[simp] theorem binary_cofan.mk_ι_app_right {C : Type u} [category C] {X : C} {Y : C} {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) : nat_trans.app (cocone.ι (binary_cofan.mk ι₁ ι₂)) walking_pair.right = ι₂ :=
  rfl

/-- If `s` is a limit binary fan over `X` and `Y`, then every pair of morphisms `f : W ⟶ X` and
    `g : W ⟶ Y` induces a morphism `l : W ⟶ s.X` satisfying `l ≫ s.fst = f` and `l ≫ s.snd = g`.
    -/
@[simp] theorem binary_fan.is_limit.lift'_coe {C : Type u} [category C] {W : C} {X : C} {Y : C} {s : binary_fan X Y} (h : is_limit s) (f : W ⟶ X) (g : W ⟶ Y) : ↑(binary_fan.is_limit.lift' h f g) = is_limit.lift h (binary_fan.mk f g) :=
  Eq.refl ↑(binary_fan.is_limit.lift' h f g)

/-- If `s` is a colimit binary cofan over `X` and `Y`,, then every pair of morphisms `f : X ⟶ W` and
    `g : Y ⟶ W` induces a morphism `l : s.X ⟶ W` satisfying `s.inl ≫ l = f` and `s.inr ≫ l = g`.
    -/
@[simp] theorem binary_cofan.is_colimit.desc'_coe {C : Type u} [category C] {W : C} {X : C} {Y : C} {s : binary_cofan X Y} (h : is_colimit s) (f : X ⟶ W) (g : Y ⟶ W) : ↑(binary_cofan.is_colimit.desc' h f g) = is_colimit.desc h (binary_cofan.mk f g) :=
  Eq.refl ↑(binary_cofan.is_colimit.desc' h f g)

/-- An abbreviation for `has_limit (pair X Y)`. -/
/-- An abbreviation for `has_colimit (pair X Y)`. -/
def has_binary_product {C : Type u} [category C] (X : C) (Y : C) :=
  has_limit (pair X Y)

def has_binary_coproduct {C : Type u} [category C] (X : C) (Y : C) :=
  has_colimit (pair X Y)

/-- If we have a product of `X` and `Y`, we can access it using `prod X Y` or
    `X ⨯ Y`. -/
def prod {C : Type u} [category C] (X : C) (Y : C) [has_binary_product X Y] : C :=
  limit (pair X Y)

/-- If we have a coproduct of `X` and `Y`, we can access it using `coprod X Y ` or
    `X ⨿ Y`. -/
def coprod {C : Type u} [category C] (X : C) (Y : C) [has_binary_coproduct X Y] : C :=
  colimit (pair X Y)

infixl:20 " ⨯ " => Mathlib.category_theory.limits.prod

infixl:20 " ⨿ " => Mathlib.category_theory.limits.coprod

/-- The projection map to the first component of the product. -/
def prod.fst {C : Type u} [category C] {X : C} {Y : C} [has_binary_product X Y] : X ⨯ Y ⟶ X :=
  limit.π (pair X Y) walking_pair.left

/-- The projecton map to the second component of the product. -/
def prod.snd {C : Type u} [category C] {X : C} {Y : C} [has_binary_product X Y] : X ⨯ Y ⟶ Y :=
  limit.π (pair X Y) walking_pair.right

/-- The inclusion map from the first component of the coproduct. -/
def coprod.inl {C : Type u} [category C] {X : C} {Y : C} [has_binary_coproduct X Y] : X ⟶ X ⨿ Y :=
  colimit.ι (pair X Y) walking_pair.left

/-- The inclusion map from the second component of the coproduct. -/
def coprod.inr {C : Type u} [category C] {X : C} {Y : C} [has_binary_coproduct X Y] : Y ⟶ X ⨿ Y :=
  colimit.ι (pair X Y) walking_pair.right

/-- The binary fan constructed from the projection maps is a limit. -/
def prod_is_prod {C : Type u} [category C] (X : C) (Y : C) [has_binary_product X Y] : is_limit (binary_fan.mk prod.fst prod.snd) :=
  is_limit.of_iso_limit (limit.is_limit (pair X Y)) (cones.ext (iso.refl (cone.X (limit.cone (pair X Y)))) sorry)

/-- The binary cofan constructed from the coprojection maps is a colimit. -/
def coprod_is_coprod {C : Type u} [category C] {X : C} {Y : C} [has_binary_coproduct X Y] : is_colimit (binary_cofan.mk coprod.inl coprod.inr) :=
  is_colimit.of_iso_colimit (colimit.is_colimit (pair X Y))
    (cocones.ext (iso.refl (cocone.X (colimit.cocone (pair X Y)))) sorry)

theorem prod.hom_ext {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_product X Y] {f : W ⟶ X ⨯ Y} {g : W ⟶ X ⨯ Y} (h₁ : f ≫ prod.fst = g ≫ prod.fst) (h₂ : f ≫ prod.snd = g ≫ prod.snd) : f = g :=
  binary_fan.is_limit.hom_ext (limit.is_limit (pair X Y)) h₁ h₂

theorem coprod.hom_ext {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_coproduct X Y] {f : X ⨿ Y ⟶ W} {g : X ⨿ Y ⟶ W} (h₁ : coprod.inl ≫ f = coprod.inl ≫ g) (h₂ : coprod.inr ≫ f = coprod.inr ≫ g) : f = g :=
  binary_cofan.is_colimit.hom_ext (colimit.is_colimit (pair X Y)) h₁ h₂

/-- If the product of `X` and `Y` exists, then every pair of morphisms `f : W ⟶ X` and `g : W ⟶ Y`
    induces a morphism `prod.lift f g : W ⟶ X ⨯ Y`. -/
def prod.lift {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) : W ⟶ X ⨯ Y :=
  limit.lift (pair X Y) (binary_fan.mk f g)

/-- diagonal arrow of the binary product in the category `fam I` -/
def diag {C : Type u} [category C] (X : C) [has_binary_product X X] : X ⟶ X ⨯ X :=
  prod.lift 𝟙 𝟙

/-- If the coproduct of `X` and `Y` exists, then every pair of morphisms `f : X ⟶ W` and
    `g : Y ⟶ W` induces a morphism `coprod.desc f g : X ⨿ Y ⟶ W`. -/
def coprod.desc {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) : X ⨿ Y ⟶ W :=
  colimit.desc (pair X Y) (binary_cofan.mk f g)

/-- codiagonal arrow of the binary coproduct -/
def codiag {C : Type u} [category C] (X : C) [has_binary_coproduct X X] : X ⨿ X ⟶ X :=
  coprod.desc 𝟙 𝟙

@[simp] theorem prod.lift_fst_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) {X' : C} (f' : X ⟶ X') : prod.lift f g ≫ prod.fst ≫ f' = f ≫ f' := sorry

@[simp] theorem prod.lift_snd {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) : prod.lift f g ≫ prod.snd = g :=
  limit.lift_π (binary_fan.mk f g) walking_pair.right

-- The simp linter says simp can prove the reassoc version of this lemma.

theorem coprod.inl_desc_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) {X' : C} (f' : W ⟶ X') : coprod.inl ≫ coprod.desc f g ≫ f' = f ≫ f' := sorry

-- The simp linter says simp can prove the reassoc version of this lemma.

theorem coprod.inr_desc_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) {X' : C} (f' : W ⟶ X') : coprod.inr ≫ coprod.desc f g ≫ f' = g ≫ f' := sorry

protected instance prod.mono_lift_of_mono_left {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) [mono f] : mono (prod.lift f g) :=
  mono_of_mono_fac (prod.lift_fst f g)

protected instance prod.mono_lift_of_mono_right {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) [mono g] : mono (prod.lift f g) :=
  mono_of_mono_fac (prod.lift_snd f g)

protected instance coprod.epi_desc_of_epi_left {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) [epi f] : epi (coprod.desc f g) :=
  epi_of_epi_fac (coprod.inl_desc f g)

protected instance coprod.epi_desc_of_epi_right {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) [epi g] : epi (coprod.desc f g) :=
  epi_of_epi_fac (coprod.inr_desc f g)

/-- If the product of `X` and `Y` exists, then every pair of morphisms `f : W ⟶ X` and `g : W ⟶ Y`
    induces a morphism `l : W ⟶ X ⨯ Y` satisfying `l ≫ prod.fst = f` and `l ≫ prod.snd = g`. -/
def prod.lift' {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) : Subtype fun (l : W ⟶ X ⨯ Y) => l ≫ prod.fst = f ∧ l ≫ prod.snd = g :=
  { val := prod.lift f g, property := sorry }

/-- If the coproduct of `X` and `Y` exists, then every pair of morphisms `f : X ⟶ W` and
    `g : Y ⟶ W` induces a morphism `l : X ⨿ Y ⟶ W` satisfying `coprod.inl ≫ l = f` and
    `coprod.inr ≫ l = g`. -/
def coprod.desc' {C : Type u} [category C] {W : C} {X : C} {Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) : Subtype fun (l : X ⨿ Y ⟶ W) => coprod.inl ≫ l = f ∧ coprod.inr ≫ l = g :=
  { val := coprod.desc f g, property := sorry }

/-- If the products `W ⨯ X` and `Y ⨯ Z` exist, then every pair of morphisms `f : W ⟶ Y` and
    `g : X ⟶ Z` induces a morphism `prod.map f g : W ⨯ X ⟶ Y ⨯ Z`. -/
def prod.map {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_product W X] [has_binary_product Y Z] (f : W ⟶ Y) (g : X ⟶ Z) : W ⨯ X ⟶ Y ⨯ Z :=
  lim_map (map_pair f g)

/-- If the coproducts `W ⨿ X` and `Y ⨿ Z` exist, then every pair of morphisms `f : W ⟶ Y` and
    `g : W ⟶ Z` induces a morphism `coprod.map f g : W ⨿ X ⟶ Y ⨿ Z`. -/
def coprod.map {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z] (f : W ⟶ Y) (g : X ⟶ Z) : W ⨿ X ⟶ Y ⨿ Z :=
  colim_map (map_pair f g)

-- Making the reassoc version of this a simp lemma seems to be more harmful than helpful.

theorem prod.comp_lift_assoc {C : Type u} [category C] {V : C} {W : C} {X : C} {Y : C} [has_binary_product X Y] (f : V ⟶ W) (g : W ⟶ X) (h : W ⟶ Y) {X' : C} (f' : X ⨯ Y ⟶ X') : f ≫ prod.lift g h ≫ f' = prod.lift (f ≫ g) (f ≫ h) ≫ f' := sorry

theorem prod.comp_diag {C : Type u} [category C] {X : C} {Y : C} [has_binary_product Y Y] (f : X ⟶ Y) : f ≫ diag Y = prod.lift f f := sorry

@[simp] theorem prod.map_fst {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_product W X] [has_binary_product Y Z] (f : W ⟶ Y) (g : X ⟶ Z) : prod.map f g ≫ prod.fst = prod.fst ≫ f :=
  lim_map_π (map_pair f g) walking_pair.left

@[simp] theorem prod.map_snd_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_product W X] [has_binary_product Y Z] (f : W ⟶ Y) (g : X ⟶ Z) {X' : C} (f' : Z ⟶ X') : prod.map f g ≫ prod.snd ≫ f' = prod.snd ≫ g ≫ f' := sorry

@[simp] theorem prod.map_id_id {C : Type u} [category C] {X : C} {Y : C} [has_binary_product X Y] : prod.map 𝟙 𝟙 = 𝟙 := sorry

@[simp] theorem prod.lift_fst_snd {C : Type u} [category C] {X : C} {Y : C} [has_binary_product X Y] : prod.lift prod.fst prod.snd = 𝟙 := sorry

@[simp] theorem prod.lift_map {C : Type u} [category C] {V : C} {W : C} {X : C} {Y : C} {Z : C} [has_binary_product W X] [has_binary_product Y Z] (f : V ⟶ W) (g : V ⟶ X) (h : W ⟶ Y) (k : X ⟶ Z) : prod.lift f g ≫ prod.map h k = prod.lift (f ≫ h) (g ≫ k) := sorry

@[simp] theorem prod.lift_fst_comp_snd_comp {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_product W Y] [has_binary_product X Z] (g : W ⟶ X) (g' : Y ⟶ Z) : prod.lift (prod.fst ≫ g) (prod.snd ≫ g') = prod.map g g' := sorry

-- We take the right hand side here to be simp normal form, as this way composition lemmas for

-- `f ≫ h` and `g ≫ k` can fire (eg `id_comp`) , while `map_fst` and `map_snd` can still work just

-- as well.

@[simp] theorem prod.map_map_assoc {C : Type u} [category C] {A₁ : C} {A₂ : C} {A₃ : C} {B₁ : C} {B₂ : C} {B₃ : C} [has_binary_product A₁ B₁] [has_binary_product A₂ B₂] [has_binary_product A₃ B₃] (f : A₁ ⟶ A₂) (g : B₁ ⟶ B₂) (h : A₂ ⟶ A₃) (k : B₂ ⟶ B₃) {X' : C} (f' : A₃ ⨯ B₃ ⟶ X') : prod.map f g ≫ prod.map h k ≫ f' = prod.map (f ≫ h) (g ≫ k) ≫ f' := sorry

-- TODO: is it necessary to weaken the assumption here?

theorem prod.map_swap {C : Type u} [category C] {A : C} {B : C} {X : C} {Y : C} (f : A ⟶ B) (g : X ⟶ Y) [has_limits_of_shape (discrete walking_pair) C] : prod.map 𝟙 f ≫ prod.map g 𝟙 = prod.map g 𝟙 ≫ prod.map 𝟙 f := sorry

theorem prod.map_comp_id {C : Type u} [category C] {X : C} {Y : C} {Z : C} {W : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_binary_product X W] [has_binary_product Z W] [has_binary_product Y W] : prod.map (f ≫ g) 𝟙 = prod.map f 𝟙 ≫ prod.map g 𝟙 := sorry

theorem prod.map_id_comp {C : Type u} [category C] {X : C} {Y : C} {Z : C} {W : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_binary_product W X] [has_binary_product W Y] [has_binary_product W Z] : prod.map 𝟙 (f ≫ g) = prod.map 𝟙 f ≫ prod.map 𝟙 g := sorry

/-- If the products `W ⨯ X` and `Y ⨯ Z` exist, then every pair of isomorphisms `f : W ≅ Y` and
    `g : X ≅ Z` induces an isomorphism `prod.map_iso f g : W ⨯ X ≅ Y ⨯ Z`. -/
@[simp] theorem prod.map_iso_inv {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_product W X] [has_binary_product Y Z] (f : W ≅ Y) (g : X ≅ Z) : iso.inv (prod.map_iso f g) = prod.map (iso.inv f) (iso.inv g) :=
  Eq.refl (iso.inv (prod.map_iso f g))

protected instance is_iso_prod {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_product W X] [has_binary_product Y Z] (f : W ⟶ Y) (g : X ⟶ Z) [is_iso f] [is_iso g] : is_iso (prod.map f g) :=
  is_iso.of_iso (prod.map_iso (as_iso f) (as_iso g))

@[simp] theorem prod.diag_map {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [has_binary_product X X] [has_binary_product Y Y] : diag X ≫ prod.map f f = f ≫ diag Y := sorry

@[simp] theorem prod.diag_map_fst_snd_assoc {C : Type u} [category C] {X : C} {Y : C} [has_binary_product X Y] [has_binary_product (X ⨯ Y) (X ⨯ Y)] {X' : C} (f' : X ⨯ Y ⟶ X') : diag (X ⨯ Y) ≫ prod.map prod.fst prod.snd ≫ f' = f' := sorry

@[simp] theorem prod.diag_map_fst_snd_comp_assoc {C : Type u} [category C] [has_limits_of_shape (discrete walking_pair) C] {X : C} {X' : C} {Y : C} {Y' : C} (g : X ⟶ Y) (g' : X' ⟶ Y') : ∀ {X'_1 : C} (f' : Y ⨯ Y' ⟶ X'_1), diag (X ⨯ X') ≫ prod.map (prod.fst ≫ g) (prod.snd ≫ g') ≫ f' = prod.map g g' ≫ f' := sorry

protected instance diag.category_theory.split_mono {C : Type u} [category C] {X : C} [has_binary_product X X] : split_mono (diag X) :=
  split_mono.mk prod.fst

@[simp] theorem coprod.desc_comp_assoc {C : Type u} [category C] {V : C} {W : C} {X : C} {Y : C} [has_binary_coproduct X Y] (f : V ⟶ W) (g : X ⟶ V) (h : Y ⟶ V) {X' : C} (f' : W ⟶ X') : coprod.desc g h ≫ f ≫ f' = coprod.desc (g ≫ f) (h ≫ f) ≫ f' := sorry

theorem coprod.diag_comp {C : Type u} [category C] {X : C} {Y : C} [has_binary_coproduct X X] (f : X ⟶ Y) : codiag X ≫ f = coprod.desc f f := sorry

@[simp] theorem coprod.inl_map {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z] (f : W ⟶ Y) (g : X ⟶ Z) : coprod.inl ≫ coprod.map f g = f ≫ coprod.inl :=
  ι_colim_map (map_pair f g) walking_pair.left

@[simp] theorem coprod.inr_map {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z] (f : W ⟶ Y) (g : X ⟶ Z) : coprod.inr ≫ coprod.map f g = g ≫ coprod.inr :=
  ι_colim_map (map_pair f g) walking_pair.right

@[simp] theorem coprod.map_id_id {C : Type u} [category C] {X : C} {Y : C} [has_binary_coproduct X Y] : coprod.map 𝟙 𝟙 = 𝟙 := sorry

@[simp] theorem coprod.desc_inl_inr {C : Type u} [category C] {X : C} {Y : C} [has_binary_coproduct X Y] : coprod.desc coprod.inl coprod.inr = 𝟙 := sorry

-- The simp linter says simp can prove the reassoc version of this lemma.

@[simp] theorem coprod.map_desc {C : Type u} [category C] {S : C} {T : C} {U : C} {V : C} {W : C} [has_binary_coproduct U W] [has_binary_coproduct T V] (f : U ⟶ S) (g : W ⟶ S) (h : T ⟶ U) (k : V ⟶ W) : coprod.map h k ≫ coprod.desc f g = coprod.desc (h ≫ f) (k ≫ g) := sorry

@[simp] theorem coprod.desc_comp_inl_comp_inr {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_coproduct W Y] [has_binary_coproduct X Z] (g : W ⟶ X) (g' : Y ⟶ Z) : coprod.desc (g ≫ coprod.inl) (g' ≫ coprod.inr) = coprod.map g g' := sorry

-- We take the right hand side here to be simp normal form, as this way composition lemmas for

-- `f ≫ h` and `g ≫ k` can fire (eg `id_comp`) , while `inl_map` and `inr_map` can still work just

-- as well.

@[simp] theorem coprod.map_map {C : Type u} [category C] {A₁ : C} {A₂ : C} {A₃ : C} {B₁ : C} {B₂ : C} {B₃ : C} [has_binary_coproduct A₁ B₁] [has_binary_coproduct A₂ B₂] [has_binary_coproduct A₃ B₃] (f : A₁ ⟶ A₂) (g : B₁ ⟶ B₂) (h : A₂ ⟶ A₃) (k : B₂ ⟶ B₃) : coprod.map f g ≫ coprod.map h k = coprod.map (f ≫ h) (g ≫ k) := sorry

-- I don't think it's a good idea to make any of the following three simp lemmas.

theorem coprod.map_swap_assoc {C : Type u} [category C] {A : C} {B : C} {X : C} {Y : C} (f : A ⟶ B) (g : X ⟶ Y) [has_colimits_of_shape (discrete walking_pair) C] {X' : C} (f' : Y ⨿ B ⟶ X') : coprod.map 𝟙 f ≫ coprod.map g 𝟙 ≫ f' = coprod.map g 𝟙 ≫ coprod.map 𝟙 f ≫ f' := sorry

theorem coprod.map_comp_id {C : Type u} [category C] {X : C} {Y : C} {Z : C} {W : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_binary_coproduct Z W] [has_binary_coproduct Y W] [has_binary_coproduct X W] : coprod.map (f ≫ g) 𝟙 = coprod.map f 𝟙 ≫ coprod.map g 𝟙 := sorry

theorem coprod.map_id_comp {C : Type u} [category C] {X : C} {Y : C} {Z : C} {W : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_binary_coproduct W X] [has_binary_coproduct W Y] [has_binary_coproduct W Z] : coprod.map 𝟙 (f ≫ g) = coprod.map 𝟙 f ≫ coprod.map 𝟙 g := sorry

/-- If the coproducts `W ⨿ X` and `Y ⨿ Z` exist, then every pair of isomorphisms `f : W ≅ Y` and
    `g : W ≅ Z` induces a isomorphism `coprod.map_iso f g : W ⨿ X ≅ Y ⨿ Z`. -/
@[simp] theorem coprod.map_iso_hom {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z] (f : W ≅ Y) (g : X ≅ Z) : iso.hom (coprod.map_iso f g) = coprod.map (iso.hom f) (iso.hom g) :=
  Eq.refl (iso.hom (coprod.map_iso f g))

protected instance is_iso_coprod {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z] (f : W ⟶ Y) (g : X ⟶ Z) [is_iso f] [is_iso g] : is_iso (coprod.map f g) :=
  is_iso.of_iso (coprod.map_iso (as_iso f) (as_iso g))

-- The simp linter says simp can prove the reassoc version of this lemma.

@[simp] theorem coprod.map_codiag {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [has_binary_coproduct X X] [has_binary_coproduct Y Y] : coprod.map f f ≫ codiag Y = codiag X ≫ f := sorry

-- The simp linter says simp can prove the reassoc version of this lemma.

theorem coprod.map_inl_inr_codiag_assoc {C : Type u} [category C] {X : C} {Y : C} [has_binary_coproduct X Y] [has_binary_coproduct (X ⨿ Y) (X ⨿ Y)] {X' : C} (f' : X ⨿ Y ⟶ X') : coprod.map coprod.inl coprod.inr ≫ codiag (X ⨿ Y) ≫ f' = f' := sorry

-- The simp linter says simp can prove the reassoc version of this lemma.

@[simp] theorem coprod.map_comp_inl_inr_codiag {C : Type u} [category C] [has_colimits_of_shape (discrete walking_pair) C] {X : C} {X' : C} {Y : C} {Y' : C} (g : X ⟶ Y) (g' : X' ⟶ Y') : coprod.map (g ≫ coprod.inl) (g' ≫ coprod.inr) ≫ codiag (Y ⨿ Y') = coprod.map g g' := sorry

/--
`has_binary_products` represents a choice of product for every pair of objects.

See https://stacks.math.columbia.edu/tag/001T.
-/
def has_binary_products (C : Type u) [category C] :=
  has_limits_of_shape (discrete walking_pair) C

/--
`has_binary_coproducts` represents a choice of coproduct for every pair of objects.

See https://stacks.math.columbia.edu/tag/04AP.
-/
def has_binary_coproducts (C : Type u) [category C] :=
  has_colimits_of_shape (discrete walking_pair) C

/-- If `C` has all limits of diagrams `pair X Y`, then it has all binary products -/
theorem has_binary_products_of_has_limit_pair (C : Type u) [category C] [∀ {X Y : C}, has_limit (pair X Y)] : has_binary_products C :=
  has_limits_of_shape.mk fun (F : discrete walking_pair ⥤ C) => has_limit_of_iso (iso.symm (diagram_iso_pair F))

/-- If `C` has all colimits of diagrams `pair X Y`, then it has all binary coproducts -/
theorem has_binary_coproducts_of_has_colimit_pair (C : Type u) [category C] [∀ {X Y : C}, has_colimit (pair X Y)] : has_binary_coproducts C :=
  has_colimits_of_shape.mk fun (F : discrete walking_pair ⥤ C) => has_colimit_of_iso (diagram_iso_pair F)

/-- The braiding isomorphism which swaps a binary product. -/
@[simp] theorem prod.braiding_hom {C : Type u} [category C] (P : C) (Q : C) [has_binary_product P Q] [has_binary_product Q P] : iso.hom (prod.braiding P Q) = prod.lift prod.snd prod.fst :=
  Eq.refl (iso.hom (prod.braiding P Q))

/-- The braiding isomorphism can be passed through a map by swapping the order. -/
theorem braid_natural {C : Type u} [category C] [has_binary_products C] {W : C} {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Z ⟶ W) : prod.map f g ≫ iso.hom (prod.braiding Y W) = iso.hom (prod.braiding X Z) ≫ prod.map g f := sorry

theorem prod.symmetry'_assoc {C : Type u} [category C] (P : C) (Q : C) [has_binary_product P Q] [has_binary_product Q P] {X' : C} (f' : P ⨯ Q ⟶ X') : prod.lift prod.snd prod.fst ≫ prod.lift prod.snd prod.fst ≫ f' = f' := sorry

/-- The braiding isomorphism is symmetric. -/
theorem prod.symmetry_assoc {C : Type u} [category C] (P : C) (Q : C) [has_binary_product P Q] [has_binary_product Q P] {X' : C} (f' : P ⨯ Q ⟶ X') : iso.hom (prod.braiding P Q) ≫ iso.hom (prod.braiding Q P) ≫ f' = f' := sorry

/-- The associator isomorphism for binary products. -/
@[simp] theorem prod.associator_hom {C : Type u} [category C] [has_binary_products C] (P : C) (Q : C) (R : C) : iso.hom (prod.associator P Q R) = prod.lift (prod.fst ≫ prod.fst) (prod.lift (prod.fst ≫ prod.snd) prod.snd) :=
  Eq.refl (iso.hom (prod.associator P Q R))

theorem prod.pentagon_assoc {C : Type u} [category C] [has_binary_products C] (W : C) (X : C) (Y : C) (Z : C) {X' : C} (f' : W ⨯ (X ⨯ (Y ⨯ Z)) ⟶ X') : prod.map (iso.hom (prod.associator W X Y)) 𝟙 ≫
    iso.hom (prod.associator W (X ⨯ Y) Z) ≫ prod.map 𝟙 (iso.hom (prod.associator X Y Z)) ≫ f' =
  iso.hom (prod.associator (W ⨯ X) Y Z) ≫ iso.hom (prod.associator W X (Y ⨯ Z)) ≫ f' := sorry

theorem prod.associator_naturality_assoc {C : Type u} [category C] [has_binary_products C] {X₁ : C} {X₂ : C} {X₃ : C} {Y₁ : C} {Y₂ : C} {Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) {X' : C} (f' : Y₁ ⨯ (Y₂ ⨯ Y₃) ⟶ X') : prod.map (prod.map f₁ f₂) f₃ ≫ iso.hom (prod.associator Y₁ Y₂ Y₃) ≫ f' =
  iso.hom (prod.associator X₁ X₂ X₃) ≫ prod.map f₁ (prod.map f₂ f₃) ≫ f' := sorry

/-- The left unitor isomorphism for binary products with the terminal object. -/
def prod.left_unitor {C : Type u} [category C] [has_terminal C] (P : C) [has_binary_product (⊤_C) P] : (⊤_C) ⨯ P ≅ P :=
  iso.mk prod.snd (prod.lift (terminal.from P) 𝟙)

/-- The right unitor isomorphism for binary products with the terminal object. -/
def prod.right_unitor {C : Type u} [category C] [has_terminal C] (P : C) [has_binary_product P (⊤_C)] : P ⨯ (⊤_C) ≅ P :=
  iso.mk prod.fst (prod.lift 𝟙 (terminal.from P))

theorem prod.left_unitor_hom_naturality_assoc {C : Type u} [category C] {X : C} {Y : C} [has_terminal C] [has_binary_products C] (f : X ⟶ Y) {X' : C} (f' : Y ⟶ X') : prod.map 𝟙 f ≫ iso.hom (prod.left_unitor Y) ≫ f' = iso.hom (prod.left_unitor X) ≫ f ≫ f' := sorry

theorem prod.left_unitor_inv_naturality {C : Type u} [category C] {X : C} {Y : C} [has_terminal C] [has_binary_products C] (f : X ⟶ Y) : iso.inv (prod.left_unitor X) ≫ prod.map 𝟙 f = f ≫ iso.inv (prod.left_unitor Y) := sorry

theorem prod.right_unitor_hom_naturality_assoc {C : Type u} [category C] {X : C} {Y : C} [has_terminal C] [has_binary_products C] (f : X ⟶ Y) {X' : C} (f' : Y ⟶ X') : prod.map f 𝟙 ≫ iso.hom (prod.right_unitor Y) ≫ f' = iso.hom (prod.right_unitor X) ≫ f ≫ f' := sorry

theorem prod_right_unitor_inv_naturality {C : Type u} [category C] {X : C} {Y : C} [has_terminal C] [has_binary_products C] (f : X ⟶ Y) : iso.inv (prod.right_unitor X) ≫ prod.map f 𝟙 = f ≫ iso.inv (prod.right_unitor Y) := sorry

theorem prod.triangle {C : Type u} [category C] [has_terminal C] [has_binary_products C] (X : C) (Y : C) : iso.hom (prod.associator X (⊤_C) Y) ≫ prod.map 𝟙 (iso.hom (prod.left_unitor Y)) =
  prod.map (iso.hom (prod.right_unitor X)) 𝟙 := sorry

/-- The braiding isomorphism which swaps a binary coproduct. -/
@[simp] theorem coprod.braiding_hom {C : Type u} [category C] [has_binary_coproducts C] (P : C) (Q : C) : iso.hom (coprod.braiding P Q) = coprod.desc coprod.inr coprod.inl :=
  Eq.refl (iso.hom (coprod.braiding P Q))

theorem coprod.symmetry'_assoc {C : Type u} [category C] [has_binary_coproducts C] (P : C) (Q : C) {X' : C} (f' : P ⨿ Q ⟶ X') : coprod.desc coprod.inr coprod.inl ≫ coprod.desc coprod.inr coprod.inl ≫ f' = f' := sorry

/-- The braiding isomorphism is symmetric. -/
theorem coprod.symmetry {C : Type u} [category C] [has_binary_coproducts C] (P : C) (Q : C) : iso.hom (coprod.braiding P Q) ≫ iso.hom (coprod.braiding Q P) = 𝟙 :=
  coprod.symmetry' P Q

/-- The associator isomorphism for binary coproducts. -/
@[simp] theorem coprod.associator_inv {C : Type u} [category C] [has_binary_coproducts C] (P : C) (Q : C) (R : C) : iso.inv (coprod.associator P Q R) =
  coprod.desc (coprod.inl ≫ coprod.inl) (coprod.desc (coprod.inr ≫ coprod.inl) coprod.inr) :=
  Eq.refl (iso.inv (coprod.associator P Q R))

theorem coprod.pentagon {C : Type u} [category C] [has_binary_coproducts C] (W : C) (X : C) (Y : C) (Z : C) : coprod.map (iso.hom (coprod.associator W X Y)) 𝟙 ≫
    iso.hom (coprod.associator W (X ⨿ Y) Z) ≫ coprod.map 𝟙 (iso.hom (coprod.associator X Y Z)) =
  iso.hom (coprod.associator (W ⨿ X) Y Z) ≫ iso.hom (coprod.associator W X (Y ⨿ Z)) := sorry

theorem coprod.associator_naturality {C : Type u} [category C] [has_binary_coproducts C] {X₁ : C} {X₂ : C} {X₃ : C} {Y₁ : C} {Y₂ : C} {Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) : coprod.map (coprod.map f₁ f₂) f₃ ≫ iso.hom (coprod.associator Y₁ Y₂ Y₃) =
  iso.hom (coprod.associator X₁ X₂ X₃) ≫ coprod.map f₁ (coprod.map f₂ f₃) := sorry

/-- The left unitor isomorphism for binary coproducts with the initial object. -/
@[simp] theorem coprod.left_unitor_inv {C : Type u} [category C] [has_binary_coproducts C] [has_initial C] (P : C) : iso.inv (coprod.left_unitor P) = coprod.inr :=
  Eq.refl (iso.inv (coprod.left_unitor P))

/-- The right unitor isomorphism for binary coproducts with the initial object. -/
@[simp] theorem coprod.right_unitor_hom {C : Type u} [category C] [has_binary_coproducts C] [has_initial C] (P : C) : iso.hom (coprod.right_unitor P) = coprod.desc 𝟙 (initial.to P) :=
  Eq.refl (iso.hom (coprod.right_unitor P))

theorem coprod.triangle {C : Type u} [category C] [has_binary_coproducts C] [has_initial C] (X : C) (Y : C) : iso.hom (coprod.associator X (⊥_C) Y) ≫ coprod.map 𝟙 (iso.hom (coprod.left_unitor Y)) =
  coprod.map (iso.hom (coprod.right_unitor X)) 𝟙 := sorry

/-- The binary product functor. -/
@[simp] theorem prod.functor_obj_map {C : Type u} [category C] [has_binary_products C] (X : C) (Y : C) (Z : C) (g : Y ⟶ Z) : functor.map (functor.obj prod.functor X) g = prod.map 𝟙 g :=
  Eq.refl (functor.map (functor.obj prod.functor X) g)

/-- The product functor can be decomposed. -/
def prod.functor_left_comp {C : Type u} [category C] [has_binary_products C] (X : C) (Y : C) : functor.obj prod.functor (X ⨯ Y) ≅ functor.obj prod.functor Y ⋙ functor.obj prod.functor X :=
  nat_iso.of_components (prod.associator X Y) sorry

/-- The binary coproduct functor. -/
@[simp] theorem coprod.functor_obj_map {C : Type u} [category C] [has_binary_coproducts C] (X : C) (Y : C) (Z : C) (g : Y ⟶ Z) : functor.map (functor.obj coprod.functor X) g = coprod.map 𝟙 g :=
  Eq.refl (functor.map (functor.obj coprod.functor X) g)

/-- The coproduct functor can be decomposed. -/
def coprod.functor_left_comp {C : Type u} [category C] [has_binary_coproducts C] (X : C) (Y : C) : functor.obj coprod.functor (X ⨿ Y) ≅ functor.obj coprod.functor Y ⋙ functor.obj coprod.functor X :=
  nat_iso.of_components (coprod.associator X Y) sorry

/--
The product comparison morphism.

In `category_theory/limits/preserves` we show this is always an iso iff F preserves binary products.
-/
def prod_comparison {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (A : C) (B : C) [has_binary_product A B] [has_binary_product (functor.obj F A) (functor.obj F B)] : functor.obj F (A ⨯ B) ⟶ functor.obj F A ⨯ functor.obj F B :=
  prod.lift (functor.map F prod.fst) (functor.map F prod.snd)

@[simp] theorem prod_comparison_fst_assoc {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {A : C} {B : C} [has_binary_product A B] [has_binary_product (functor.obj F A) (functor.obj F B)] {X' : D} (f' : functor.obj F A ⟶ X') : prod_comparison F A B ≫ prod.fst ≫ f' = functor.map F prod.fst ≫ f' := sorry

@[simp] theorem prod_comparison_snd_assoc {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {A : C} {B : C} [has_binary_product A B] [has_binary_product (functor.obj F A) (functor.obj F B)] {X' : D} (f' : functor.obj F B ⟶ X') : prod_comparison F A B ≫ prod.snd ≫ f' = functor.map F prod.snd ≫ f' := sorry

/-- Naturality of the prod_comparison morphism in both arguments. -/
theorem prod_comparison_natural_assoc {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {A : C} {A' : C} {B : C} {B' : C} [has_binary_product A B] [has_binary_product A' B'] [has_binary_product (functor.obj F A) (functor.obj F B)] [has_binary_product (functor.obj F A') (functor.obj F B')] (f : A ⟶ A') (g : B ⟶ B') {X' : D} (f' : functor.obj F A' ⨯ functor.obj F B' ⟶ X') : functor.map F (prod.map f g) ≫ prod_comparison F A' B' ≫ f' =
  prod_comparison F A B ≫ prod.map (functor.map F f) (functor.map F g) ≫ f' := sorry

/--
The product comparison morphism from `F(A ⨯ -)` to `FA ⨯ F-`, whose components are given by
`prod_comparison`.
-/
def prod_comparison_nat_trans {C : Type u} [category C] {D : Type u₂} [category D] [has_binary_products C] [has_binary_products D] (F : C ⥤ D) (A : C) : functor.obj prod.functor A ⋙ F ⟶ F ⋙ functor.obj prod.functor (functor.obj F A) :=
  nat_trans.mk fun (B : C) => prod_comparison F A B

theorem inv_prod_comparison_map_fst_assoc {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {A : C} {B : C} [has_binary_product A B] [has_binary_product (functor.obj F A) (functor.obj F B)] [is_iso (prod_comparison F A B)] {X' : D} (f' : functor.obj F A ⟶ X') : inv (prod_comparison F A B) ≫ functor.map F prod.fst ≫ f' = prod.fst ≫ f' := sorry

theorem inv_prod_comparison_map_snd_assoc {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {A : C} {B : C} [has_binary_product A B] [has_binary_product (functor.obj F A) (functor.obj F B)] [is_iso (prod_comparison F A B)] {X' : D} (f' : functor.obj F B ⟶ X') : inv (prod_comparison F A B) ≫ functor.map F prod.snd ≫ f' = prod.snd ≫ f' := sorry

/-- If the product comparison morphism is an iso, its inverse is natural. -/
theorem prod_comparison_inv_natural {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {A : C} {A' : C} {B : C} {B' : C} [has_binary_product A B] [has_binary_product A' B'] [has_binary_product (functor.obj F A) (functor.obj F B)] [has_binary_product (functor.obj F A') (functor.obj F B')] (f : A ⟶ A') (g : B ⟶ B') [is_iso (prod_comparison F A B)] [is_iso (prod_comparison F A' B')] : inv (prod_comparison F A B) ≫ functor.map F (prod.map f g) =
  prod.map (functor.map F f) (functor.map F g) ≫ inv (prod_comparison F A' B') := sorry

/--
The natural isomorphism `F(A ⨯ -) ≅ FA ⨯ F-`, provided each `prod_comparison F A B` is an
isomorphism (as `B` changes).
-/
def prod_comparison_nat_iso {C : Type u} [category C] {D : Type u₂} [category D] (F : C ⥤ D) [has_binary_products C] [has_binary_products D] (A : C) [(B : C) → is_iso (prod_comparison F A B)] : functor.obj prod.functor A ⋙ F ≅ F ⋙ functor.obj prod.functor (functor.obj F A) :=
  iso.mk (prod_comparison_nat_trans F A) (inv (nat_trans.mk fun (B : C) => prod_comparison F A B))


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

notation, basic datatypes and type classes
-/
prelude

notation `Prop` := Sort 0
notation f ` $ `:1 a:0 := f a

universes u v w

/--
The kernel definitional equality test (t =?= s) has special support for id_delta applications.
It implements the following rules

   1)   (id_delta t) =?= t
   2)   t =?= (id_delta t)
   3)   (id_delta t) =?= s  IF (unfold_of t) =?= s
   4)   t =?= id_delta s    IF t =?= (unfold_of s)

This is mechanism for controlling the delta reduction (aka unfolding) used in the kernel.

We use id_delta applications to address performance problems when type checking
lemmas generated by the equation compiler.
-/
@[inline] def id_delta {α : Sort u} (a : α) : α :=
a

/-- Gadget for optional parameter support. -/
@[reducible] def opt_param (α : Sort u) (default : α) : Sort u :=
α

/-- Gadget for marking output parameters in type classes. -/
@[reducible] def out_param (α : Sort u) : Sort u := α

/-
  id_rhs is an auxiliary declaration used in the equation compiler to address performance
  issues when proving equational lemmas. The equation compiler uses it as a marker.
-/
abbreviation id_rhs (α : Sort u) (a : α) : α := a

inductive punit : Sort u
| star : punit

/-- An abbreviation for `punit.{0}`, its most common instantiation.
    This type should be preferred over `punit` where possible to avoid
    unnecessary universe parameters. -/
abbreviation unit : Type := punit

@[pattern] abbreviation unit.star : unit := punit.star

/--
Gadget for defining thunks, thunk parameters have special treatment.
Example: given
      def f (s : string) (t : thunk nat) : nat
an application
     f "hello" 10
 is converted into
     f "hello" (λ _, 10)
-/
@[reducible] def thunk (α : Type u) : Type u :=
unit → α

inductive true : Prop
| intro : true

inductive false : Prop

inductive empty : Type

/--
Logical not.

`not P`, with notation `¬ P`, is the `Prop` which is true if and only if `P` is false. It is
internally represented as `P → false`, so one way to prove a goal `⊢ ¬ P` is to use `intro h`,
which gives you a new hypothesis `h : P` and the goal `⊢ false`.

A hypothesis `h : ¬ P` can be used in term mode as a function, so if `w : P` then `h w : false`.

Related mathlib tactic: `contrapose`.
-/
def not (a : Prop) := a → false
prefix `¬`:40 := not

inductive eq {α : Sort u} (a : α) : α → Prop
| refl [] : eq a
/-* \pi  *-/
/-
Initialize the quotient module, which effectively adds the following definitions:

constant quot {α : Sort u} (r : α → α → Prop) : Sort u

constant quot.mk {α : Sort u} (r : α → α → Prop) (a : α) : quot r

constant quot.lift {α : Sort u} {r : α → α → Prop} {β : Sort v} (f : α → β) :
  (∀ a b : α, r a b → eq (f a) (f b)) → quot r → β

constant quot.ind {α : Sort u} {r : α → α → Prop} {β : quot r → Prop} :
  (∀ a : α, β (quot.mk r a)) → ∀ q : quot r, β q-

Also the reduction rule:

quot.lift f _ (quot.mk a) ~~> f a

-/
init_quotient

/--
Heterogeneous equality.

Its purpose is to write down equalities between terms whose types are not definitionally equal.
For example, given `x : vector α n` and `y : vector α (0+n)`, `x = y` doesn't typecheck but `x == y` does.

If you have a goal `⊢ x == y`,
your first instinct should be to ask (either yourself, or on [zulip](https://leanprover.zulipchat.com/))
if something has gone wrong already.
If you really do need to follow this route,
you may find the lemmas `eq_rec_heq` and `eq_mpr_heq` useful.
-/
inductive heq {α : Sort u} (a : α) : Π {β : Sort u}, β → Prop
| refl [] : heq a

structure prod (α : Type u) (β : Type v) :=
(fst : α) (snd : β)

/-- Similar to `prod`, but α and β can be propositions.
   We use this type internally to automatically generate the brec_on recursor. -/
structure pprod (α : Sort u) (β : Sort v) :=
(fst : α) (snd : β)

/--
Logical and.

`and P Q`, with notation `P ∧ Q`, is the `Prop` which is true precisely when `P` and `Q` are
both true.

To prove a goal `⊢ P ∧ Q`, you can use the tactic `split`,
which gives two separate goals `⊢ P` and `⊢ Q`.

Given a hypothesis `h : P ∧ Q`, you can use the tactic `cases h with hP hQ`
to obtain two new hypotheses `hP : P` and `hQ : Q`. See also the `obtain` or `rcases` tactics in
mathlib.
-/
structure and (a b : Prop) : Prop :=
intro :: (left : a) (right : b)

/-* Let $a$ and $b$ be two propositions, $a \and b$ implies $a$. *-/
lemma and.elim_left {a b : Prop} (h : and a b) : a := h.1
/-* Let $a$ and $b$ be two propositions, $a \and b$ implies $b$. *-/
lemma and.elim_right {a b : Prop} (h : and a b) : b := h.2

/- eq basic support -/

infix ` = `:50 := eq

attribute [refl] eq.refl

/- This is a `def`, so that it can be used as pattern in the equation compiler. -/
@[pattern] def rfl {α : Sort u} {a : α} : a = a := eq.refl a

@[elab_as_eliminator, subst]
/-*  *-/
lemma eq.subst {α : Sort u} {P : α → Prop} {a b : α} (h₁ : a = b) (h₂ : P a) : P b :=
eq.rec h₂ h₁

infixr ` ▸ `:75 := eq.subst

@[trans] lemma eq.trans {α : Sort u} {a b c : α} (h₁ : a = b) (h₂ : b = c) : a = c :=
h₂ ▸ h₁

@[symm] lemma eq.symm {α : Sort u} {a b : α} (h : a = b) : b = a :=
h ▸ rfl

infix ` == `:50 := heq

/- This is a `def`, so that it can be used as pattern in the equation compiler. -/
@[pattern] def heq.rfl {α : Sort u} {a : α} : a == a := heq.refl a

lemma eq_of_heq {α : Sort u} {a a' : α} (h : a == a') : a = a' :=
have ∀ (α' : Sort u) (a' : α') (h₁ : @heq α a α' a') (h₂ : α = α'), (eq.rec_on h₂ a : α') = a', from
  λ (α' : Sort u) (a' : α') (h₁ : @heq α a α' a'), heq.rec_on h₁ (λ h₂ : α = α, rfl),
show (eq.rec_on (eq.refl α) a : α) = a', from
  this α a' h (eq.refl α)

/- The following four lemmas could not be automatically generated when the
   structures were declared, so we prove them manually here. -/
lemma prod.mk.inj {α : Type u} {β : Type v} {x₁ : α} {y₁ : β} {x₂ : α} {y₂ : β}
  : (x₁, y₁) = (x₂, y₂) → and (x₁ = x₂) (y₁ = y₂) :=
λ h, prod.no_confusion h (λ h₁ h₂, ⟨h₁, h₂⟩)

lemma prod.mk.inj_arrow {α : Type u} {β : Type v} {x₁ : α} {y₁ : β} {x₂ : α} {y₂ : β}
  : (x₁, y₁) = (x₂, y₂) → Π ⦃P : Sort w⦄, (x₁ = x₂ → y₁ = y₂ → P) → P :=
λ h₁ _ h₂, prod.no_confusion h₁ h₂

lemma pprod.mk.inj {α : Sort u} {β : Sort v} {x₁ : α} {y₁ : β} {x₂ : α} {y₂ : β}
  : pprod.mk x₁ y₁ = pprod.mk x₂ y₂ → and (x₁ = x₂) (y₁ = y₂) :=
λ h, pprod.no_confusion h (λ h₁ h₂, ⟨h₁, h₂⟩)

lemma pprod.mk.inj_arrow {α : Type u} {β : Type v} {x₁ : α} {y₁ : β} {x₂ : α} {y₂ : β}
  : (x₁, y₁) = (x₂, y₂) → Π ⦃P : Sort w⦄, (x₁ = x₂ → y₁ = y₂ → P) → P :=
λ h₁ _ h₂, prod.no_confusion h₁ h₂

inductive sum (α : Type u) (β : Type v)
| inl (val : α) : sum
| inr (val : β) : sum

inductive psum (α : Sort u) (β : Sort v)
| inl (val : α) : psum
| inr (val : β) : psum

/--
Logical or.

`or P Q`, with notation `P ∨ Q`, is the proposition which is true if and only if `P` or `Q` is
true.

To prove a goal `⊢ P ∨ Q`, if you know which alternative you want to prove,
you can use the tactics `left` (which gives the goal `⊢ P`)
or `right` (which gives the goal `⊢ Q`).

Given a hypothesis `h : P ∨ Q` and goal `⊢ R`,
the tactic `cases h` will give you two copies of the goal `⊢ R`,
with the hypothesis `h : P` in the first, and the hypothesis `h : Q` in the second.
-/
inductive or (a b : Prop) : Prop
| inl (h : a) : or
| inr (h : b) : or

lemma or.intro_left {a : Prop} (b : Prop) (ha : a) : or a b :=
or.inl ha

lemma or.intro_right (a : Prop) {b : Prop} (hb : b) : or a b :=
or.inr hb

structure sigma {α : Type u} (β : α → Type v) :=
mk :: (fst : α) (snd : β fst)

structure psigma {α : Sort u} (β : α → Sort v) :=
mk :: (fst : α) (snd : β fst)

inductive bool : Type
| ff : bool
| tt : bool

/- Remark: subtype must take a Sort instead of Type because of the axiom strong_indefinite_description. -/
structure subtype {α : Sort u} (p : α → Prop) :=
(val : α) (property : p val)

attribute [pp_using_anonymous_constructor] sigma psigma subtype pprod and

class inductive decidable (p : Prop)
| is_false (h : ¬p) : decidable
| is_true  (h : p) : decidable

@[reducible]
def decidable_pred {α : Sort u} (r : α → Prop) :=
Π (a : α), decidable (r a)

@[reducible]
def decidable_rel {α : Sort u} (r : α → α → Prop) :=
Π (a b : α), decidable (r a b)

@[reducible]
def decidable_eq (α : Sort u) :=
decidable_rel (@eq α)

inductive option (α : Type u)
| none : option
| some (val : α) : option

export option (none some)
export bool (ff tt)

inductive list (T : Type u)
| nil : list
| cons (hd : T) (tl : list) : list

infixr ` :: `:67 := list.cons
notation `[` l:(foldr `, ` (h t, list.cons h t) list.nil `]`) := l

inductive nat
| zero : nat
| succ (n : nat) : nat

structure unification_constraint :=
{α : Type u} (lhs : α) (rhs : α)

infix ` ≟ `:50   := unification_constraint.mk
infix ` =?= `:50 := unification_constraint.mk

structure unification_hint :=
(pattern : unification_constraint)
(constraints : list unification_constraint)

/- Declare builtin and reserved notation -/

class has_zero     (α : Type u) := (zero : α)
class has_one      (α : Type u) := (one : α)
class has_add      (α : Type u) := (add : α → α → α)
class has_mul      (α : Type u) := (mul : α → α → α)
class has_inv      (α : Type u) := (inv : α → α)
class has_neg      (α : Type u) := (neg : α → α)
class has_sub      (α : Type u) := (sub : α → α → α)
class has_div      (α : Type u) := (div : α → α → α)
class has_dvd      (α : Type u) := (dvd : α → α → Prop)
class has_mod      (α : Type u) := (mod : α → α → α)
class has_le       (α : Type u) := (le : α → α → Prop)
class has_lt       (α : Type u) := (lt : α → α → Prop)
class has_append   (α : Type u) := (append : α → α → α)
class has_andthen  (α : Type u) (β : Type v) (σ : out_param $ Type w) := (andthen : α → β → σ)
class has_union    (α : Type u) := (union : α → α → α)
class has_inter    (α : Type u) := (inter : α → α → α)
class has_sdiff    (α : Type u) := (sdiff : α → α → α)
class has_equiv    (α : Sort u) := (equiv : α → α → Prop)
class has_subset   (α : Type u) := (subset : α → α → Prop)
class has_ssubset  (α : Type u) := (ssubset : α → α → Prop)
/- Type classes has_emptyc and has_insert are
   used to implement polymorphic notation for collections.
   Example: {a, b, c}. -/
class has_emptyc   (α : Type u) := (emptyc : α)
class has_insert   (α : out_param $ Type u) (γ : Type v) := (insert : α → γ → γ)
class has_singleton (α : out_param $ Type u) (β : Type v) := (singleton : α → β)
/- Type class used to implement the notation { a ∈ c | p a } -/
class has_sep (α : out_param $ Type u) (γ : Type v) :=
(sep : (α → Prop) → γ → γ)
/- Type class for set-like membership -/
class has_mem (α : out_param $ Type u) (γ : Type v) := (mem : α → γ → Prop)

class has_pow (α : Type u) (β : Type v) :=
(pow : α → β → α)

export has_andthen (andthen)
export has_pow (pow)

infix ` ∈ `:50   := has_mem.mem
notation a ` ∉ `:50 s:50 := ¬ has_mem.mem a s
infixl ` + `:65  := has_add.add
infixl ` * `:70  := has_mul.mul
infixl ` - `:65  := has_sub.sub
infixl ` / `:70  := has_div.div
infix ` ∣ `:50   := has_dvd.dvd -- Note this is different to `|`.
infixl ` % `:70  := has_mod.mod
prefix `-`:75    := has_neg.neg
infix ` <= `:50  := has_le.le
infix ` ≤ `:50   := has_le.le
infix ` < `:50   := has_lt.lt
infixl ` ++ `:65 := has_append.append
infixl `; `:1    := andthen
notation `∅`     := has_emptyc.emptyc
infixl ` ∪ `:65  := has_union.union
infixl ` ∩ `:70  := has_inter.inter
infix ` ⊆ `:50   := has_subset.subset
infix ` ⊂ `:50   := has_ssubset.ssubset
infix ` \ `:70   := has_sdiff.sdiff
infix ` ≈ `:50   := has_equiv.equiv
infixr ` ^ `:80  := has_pow.pow

export has_append (append)

@[reducible] def ge {α : Type u} [has_le α] (a b : α) : Prop := has_le.le b a
@[reducible] def gt {α : Type u} [has_lt α] (a b : α) : Prop := has_lt.lt b a

infix ` >= `:50 := ge
infix ` ≥ `:50  := ge
infix ` > `:50  := gt

@[reducible] def superset {α : Type u} [has_subset α] (a b : α) : Prop := has_subset.subset b a
@[reducible] def ssuperset {α : Type u} [has_ssubset α] (a b : α) : Prop := has_ssubset.ssubset b a

infix ` ⊇ `:50 := superset
infix ` ⊃ `:50 := ssuperset

def bit0 {α : Type u} [s  : has_add α] (a  : α)                 : α := a + a
def bit1 {α : Type u} [s₁ : has_one α] [s₂ : has_add α] (a : α) : α := (bit0 a) + 1

attribute [pattern] has_zero.zero has_one.one bit0 bit1 has_add.add has_neg.neg has_mul.mul

export has_insert (insert)

class is_lawful_singleton (α : Type u) (β : Type v) [has_emptyc β] [has_insert α β]
  [has_singleton α β] : Prop :=
(insert_emptyc_eq : ∀ (x : α), (insert x ∅ : β) = {x})

export has_singleton (singleton)
export is_lawful_singleton (insert_emptyc_eq)

attribute [simp] insert_emptyc_eq

/- nat basic instances -/

namespace nat
  protected def add : nat → nat → nat
  | a  zero     := a
  | a  (succ b) := succ (add a b)

  /- We mark the following definitions as pattern to make sure they can be used in recursive equations,
     and reduced by the equation compiler. -/
  attribute [pattern] nat.add nat.add._main
end nat

instance : has_zero nat := ⟨nat.zero⟩

instance : has_one nat := ⟨nat.succ (nat.zero)⟩

instance : has_add nat := ⟨nat.add⟩

def std.priority.default : nat := 1000
def std.priority.max     : nat := 0xFFFFFFFF

namespace nat
  protected def prio := std.priority.default + 100
end nat

/-
  Global declarations of right binding strength

  If a module reassigns these, it will be incompatible with other modules that adhere to these
  conventions.

  When hovering over a symbol, use "C-c C-k" to see how to input it.
-/
def std.prec.max   : nat := 1024 -- the strength of application, identifiers, (, [, etc.
def std.prec.arrow : nat := 25

/-
The next def is "max + 10". It can be used e.g. for postfix operations that should
be stronger than application.
-/

def std.prec.max_plus : nat := std.prec.max + 10

postfix `⁻¹`:std.prec.max_plus := has_inv.inv  -- input with \sy or \-1 or \inv

infixr ` × `:35 := prod
-- notation for n-ary tuples

/- sizeof -/

class has_sizeof (α : Sort u) :=
(sizeof : α → nat)

def sizeof {α : Sort u} [s : has_sizeof α] : α → nat :=
has_sizeof.sizeof

/-
Declare sizeof instances and lemmas for types declared before has_sizeof.
From now on, the inductive compiler will automatically generate sizeof instances and lemmas.
-/

/- Every type `α` has a default has_sizeof instance that just returns 0 for every element of `α` -/
protected def default.sizeof (α : Sort u) : α → nat
| a := 0

instance default_has_sizeof (α : Sort u) : has_sizeof α :=
⟨default.sizeof α⟩

protected def nat.sizeof : nat → nat
| n := n

instance : has_sizeof nat :=
⟨nat.sizeof⟩

protected def prod.sizeof {α : Type u} {β : Type v} [has_sizeof α] [has_sizeof β] : (prod α β) → nat
| ⟨a, b⟩ := 1 + sizeof a + sizeof b

instance (α : Type u) (β : Type v) [has_sizeof α] [has_sizeof β] : has_sizeof (prod α β) :=
⟨prod.sizeof⟩

protected def sum.sizeof {α : Type u} {β : Type v} [has_sizeof α] [has_sizeof β] : (sum α β) → nat
| (sum.inl a) := 1 + sizeof a
| (sum.inr b) := 1 + sizeof b

instance (α : Type u) (β : Type v) [has_sizeof α] [has_sizeof β] : has_sizeof (sum α β) :=
⟨sum.sizeof⟩

protected def psum.sizeof {α : Type u} {β : Type v} [has_sizeof α] [has_sizeof β] : (psum α β) → nat
| (psum.inl a) := 1 + sizeof a
| (psum.inr b) := 1 + sizeof b

instance (α : Type u) (β : Type v) [has_sizeof α] [has_sizeof β] : has_sizeof (psum α β) :=
⟨psum.sizeof⟩

protected def sigma.sizeof {α : Type u} {β : α → Type v} [has_sizeof α] [∀ a, has_sizeof (β a)] : sigma β → nat
| ⟨a, b⟩ := 1 + sizeof a + sizeof b

instance (α : Type u) (β : α → Type v) [has_sizeof α] [∀ a, has_sizeof (β a)] : has_sizeof (sigma β) :=
⟨sigma.sizeof⟩

protected def psigma.sizeof {α : Type u} {β : α → Type v} [has_sizeof α] [∀ a, has_sizeof (β a)] : psigma β → nat
| ⟨a, b⟩ := 1 + sizeof a + sizeof b

instance (α : Type u) (β : α → Type v) [has_sizeof α] [∀ a, has_sizeof (β a)] : has_sizeof (psigma β) :=
⟨psigma.sizeof⟩

protected def punit.sizeof : punit → nat
| u := 1

instance : has_sizeof punit := ⟨punit.sizeof⟩

protected def bool.sizeof : bool → nat
| b := 1

instance : has_sizeof bool := ⟨bool.sizeof⟩

protected def option.sizeof {α : Type u} [has_sizeof α] : option α → nat
| none     := 1
| (some a) := 1 + sizeof a

instance (α : Type u) [has_sizeof α] : has_sizeof (option α) :=
⟨option.sizeof⟩

protected def list.sizeof {α : Type u} [has_sizeof α] : list α → nat
| list.nil        := 1
| (list.cons a l) := 1 + sizeof a + list.sizeof l

instance (α : Type u) [has_sizeof α] : has_sizeof (list α) :=
⟨list.sizeof⟩

protected def subtype.sizeof {α : Type u} [has_sizeof α] {p : α → Prop} : subtype p → nat
| ⟨a, _⟩ := sizeof a

instance {α : Type u} [has_sizeof α] (p : α → Prop) : has_sizeof (subtype p) :=
⟨subtype.sizeof⟩

lemma nat_add_zero (n : nat) : n + 0 = n := rfl

/- Combinator calculus -/
namespace combinator
universes u₁ u₂ u₃
def I {α : Type u₁} (a : α) := a
def K {α : Type u₁} {β : Type u₂} (a : α) (b : β) := a
def S {α : Type u₁} {β : Type u₂} {γ : Type u₃} (x : α → β → γ) (y : α → β) (z : α) := x z (y z)
end combinator

/-- Auxiliary datatype for #[ ... ] notation.
    #[1, 2, 3, 4] is notation for

    bin_tree.node
      (bin_tree.node (bin_tree.leaf 1) (bin_tree.leaf 2))
      (bin_tree.node (bin_tree.leaf 3) (bin_tree.leaf 4))

    We use this notation to input long sequences without exhausting the system stack space.
    Later, we define a coercion from `bin_tree` into `list`.
-/
inductive bin_tree (α : Type u)
| empty : bin_tree
| leaf (val : α) : bin_tree
| node (left right : bin_tree) : bin_tree

attribute [elab_simple] bin_tree.node bin_tree.leaf

/-- Like `by apply_instance`, but not dependent on the tactic framework. -/
@[reducible] def infer_instance {α : Sort u} [i : α] : α := i


import parlang.defs

open parlang

section

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

/-- syncable with the exception that no thread is allowed to store
or load in stores and loads respectively. Adding to stores or load makes this property stricter -/
def syncable' (shole : set ι) (lhole : set ι) (s : state n σ τ) (m : memory τ) : Prop :=
state.syncable s m ∧
(∀ i tid, (i ∈ shole → i ∉ (s.threads.nth tid).stores) ∧
        (i ∈ lhole → i ∉ (s.threads.nth tid).loads))

lemma syncable_syncable' (s : state n σ τ) (m : memory τ) : syncable' ∅ ∅ s m ↔ state.syncable s m := begin
    unfold syncable',
    simp,
end

end