Section CoproductFacts.
Context {obj : Type} {C : Hom obj}.
Context {Eq2_C : Eq2 C}.
Context {E_Eq2_C : forall a b, @Equivalence (C a b) eq2}.
Context {Id_C : Id_ C} {Cat_C : Cat C}.
Context {Category_C : Category C}.
Context {bif : binop obj}.
Context {Case_C : Case C bif}
{Inl_C : Inl C bif}
{Inr_C : Inr C bif}.
Context {Coproduct_C : Coproduct C bif}.
Ltac cat_auto :=
unfold_coproduct;
repeat progress (reflexivity || (try cat_auto_simpl); try apply coprod_split).
Ltac cat_auto' :=
repeat intro;
repeat match goal with
| [ |- eq2 _ _ ] => fail 1
| _ => red
end;
cat_auto.
Global Instance BimapId_Coproduct : BimapId C bif.
Global Instance BimapCat_Coproduct : BimapCat C bif.
(** The coproduct is commutative *)
Global Instance SwapInvolutive_Coproduct {a b : obj}
: SemiIso C (swap_ a b) swap.
Global Instance AssocLAssocL_Coproduct : AssocLAssocL C bif.
Context {i : obj}.
Context {Initial_i : Initial C i}.
Context {InitialObject_i : InitialObject C i}.
(* Vanishing. These two loops:  [[ +----------+ | +-----+  | | | ### |  | | +-###-+I | +---###----+J A-----###-------B ### ]]  ... can be rewired as a single one:   [[ +-------+ |  ###  | +--###--+(I+J) +--###--+ A-----###-----B ### ]]  *)
(* Here we show that we can implement [ITree.cat] using [bimap], [loop], and composition with the monoidal natural isomorphisms. *)
(** Utility: lemma to ease working forward in an equational proof. Make it more convenient to rewrite subterm only on one side of the equation. *)
Fact fwd_eqn {a b} (f g : C a b) :
(forall h, h ⩯ f -> h ⩯ g) -> f ⩯ g.
(** Utility: lemmas to ease forward reasoning *)
Fact cat_eq2_l {a b c} (h : C a b) (f g : C b c) :
f ⩯ g ->
h >>> f ⩯ h >>> g.
Fact cat_eq2_r {a b c} (h : C b c) (f g : C a b) :
f ⩯ g ->
f >>> h ⩯ g >>> h.
Fact local_rewrite1 {a b c}:
bimap (id_ a) (swap_ b c) >>> assoc_l >>> swap
⩯ assoc_l >>> bimap swap (id_ c) >>> assoc_r.
Fact local_rewrite2 {a b c}:
swap >>> assoc_r >>> bimap (id_ _) swap
⩯ assoc_l_ a b c >>> bimap swap (id_ _) >>> assoc_r.

Lemma loop_superposing_2 {a b c d e}
(ab : C a b) (cd : C (bif e c) (bif e d))
: bimap ab (loop cd)
⩯ loop (assoc_l >>> bimap swap (id_ _)
>>> assoc_r
>>> bimap ab cd
>>> assoc_l >>> bimap swap (id_ _) >>> assoc_r).