Program Definition term_id : (Type_Cat –≻ (Type_Cat × Type_Cat))%functor :=
{|
FO := fun a => (@CCC_term Type_Cat _, a);
FA := fun a b f => (@id _ (@CCC_term Type_Cat _), f)
|}.
Definition S_nat_func : (Type_Cat –≻ Type_Cat)%functor :=
((+ᶠⁿᶜ Type_Cat _) ∘ term_id)%functor.
(* S_nat_func defined *)
Definition S_nat_alg_cat := Algebra_Cat S_nat_func.
Program Definition nat_alg : Algebra S_nat_func :=
{|
Alg_Carrier := nat;
Constructors :=
fun x =>
match x with
| inl a => 0
| inr n => S n
end
|}.
(* morphism from nat_alg to another alg *)
Program Definition nat_alg_morph alg' : Algebra_Hom nat_alg alg' :=
{|
Alg_map :=
fun x =>
(fix f (n : nat) :=
match n with
| O => (Constructors alg') (inl tt)
| S n' => (Constructors alg') (inr (f n'))
end) x
|}.
Next Obligation. (* alg_map_com *)
Program Definition nat_alg_init : (𝟘_ S_nat_alg_cat)%object :=
{|
terminal := nat_alg;
t_morph := nat_alg_morph
|}.
Next Obligation.
CoInductive CoNat : Set :=
| CoO : CoNat
| CoS : CoNat -> CoNat
.
CoInductive CoNat_eq : CoNat -> CoNat -> Prop :=
| CNOeq : CoNat_eq CoO CoO
| CNSeq : forall (n n' : CoNat), CoNat_eq n n' -> CoNat_eq (CoS n) (CoS n')
.
Definition S_nat_coalg_cat := @CoAlgebra_Cat Type_Cat S_nat_func.
Program Definition CoNat_coalg : @CoAlgebra Type_Cat S_nat_func :=
{|
Alg_Carrier := CoNat;
Constructors :=
fun x : CoNat =>
match x return unit + CoNat  with
| CoO => inl tt
| CoS x' => inr x'
end
|}.
(* morphism from another alg to CoNat_coalg *)
Program Definition CoNat_coalg_morph coalg' : CoAlgebra_Hom CoNat_coalg coalg'
:=
{|
Alg_map :=
cofix f (x : Alg_Carrier coalg') : CoNat :=
match Constructors coalg' x return CoNat with
| inl _ => CoO
| inr s => CoS (f s)
end
|}.
Next Obligation. (* coalg_map_com *)
(* CoNat_coalg_morph defined *)
(* The following two lemmas help go around Bug 5215. *)

Lemma inr_inl A B (x : A) (y : B) : inr x = inl y → False.