(* * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor. * *)
Require Omega.
Local Open Scope nat_scope.
Program Definition EqSetoid (A:Type) : Setoid A := @Build_Setoid A (@eq A) _.
Next Obligation.
constructor; hnf; intuition.
transitivity y; auto.
Qed.
Program Instance ProdSetoid `(Setoid A) `(Setoid B) : Setoid (A * B) :=
{ equiv := fun z w => equiv (fst z) (fst w) /\ equiv (snd z) (snd w)
}.
Next Obligation.
constructor; hnf; intuition; simpl in *.
transitivity a0; auto.
transitivity b0; auto.
Qed.
Inductive Mor `(As:Setoid A) `(Bs:Setoid B) :=
{ mor_fun :> A -> B
; mor_prf :> @Morphism (A -> B) (equiv ==> equiv)%signature mor_fun
}.
Implicit Arguments Build_Mor [A B].
Program Definition fstM `{As:Setoid A} `{Bs:Setoid B} : Mor (ProdSetoid As Bs) As
:= Build_Mor _ _ (@fst A B) _.
Next Obligation.
hnf; simpl; intuition.
Qed.
Program Definition sndM `{As:Setoid A} `{Bs:Setoid B} : Mor (ProdSetoid As Bs) Bs
:= Build_Mor _ _ (@snd A B) _.
Next Obligation.
hnf; simpl; intuition.
Qed.
Definition ext_equiv `(As:Setoid A) `(Bs:Setoid B) : relation (Mor As Bs) :=
fun f g => forall a a':A, a == a' -> f a == g a'.

Lemma ext_is_equiv `(As:Setoid A) `(Bs:Setoid B) : Equivalence (ext_equiv As Bs).
Instance MorSetoid  `(As:Setoid A) `(Bs:Setoid B) : Setoid (Mor As Bs) :=
{ equiv := ext_equiv As Bs
; setoid_equiv := ext_is_equiv As Bs
}.