(** The corresponding order is a strict order. **)
Definition comparableLt {A:Type} (C: Comparable A) : relation A :=
fun x y => compare x y = Lt.
Instance ComparableLtStrictOrder {A:Type} (C: Comparable A) :
StrictOrder (comparableLt C).
(** nat is comparable. **)
Program Instance natComparable : Comparable nat :=
{ compare := Nat.compare }.
Next Obligation.
symmetry.
destruct (Nat.compare x y)  as [] eqn:?.
rewrite Nat.compare_eq_iff in Heqc.
destruct Heqc.
rewrite Nat.compare_eq_iff.
trivial.
rewrite <- nat_compare_lt in *.
rewrite <- nat_compare_gt in *.
trivial.
rewrite <- nat_compare_lt in *.
rewrite <- nat_compare_gt in *.
trivial.
Qed.
Next Obligation.
destruct c.
rewrite Nat.compare_eq_iff in *; destruct H; assumption.
rewrite <- nat_compare_lt in *.
apply (Nat.lt_trans _ _ _ H H0).
rewrite <- nat_compare_gt in *.
apply (gt_trans _ _ _ H H0).
Qed.
(** A pair of comparable is comparable. **)
Program Instance PairComparable {A:Type} (CA:Comparable A) {B:Type} (CB:Comparable B) :
Comparable (A*B) :=
{ compare := fun x y =>
let (xa, xb) := x in let (ya, yb) := y in
match compare xa ya return comparison with
| Eq => compare xb yb
| x => x
end }.
Next Obligation.
destruct x, y.
rewrite <- (compare_antisym a a0).
rewrite <- (compare_antisym b b0).
destruct (compare a a0); intuition.
Qed.
Next Obligation.
destruct x, y, z.
destruct (compare a a0) as [] eqn:?, (compare a0 a1) as [] eqn:?;
try (rewrite <- H0 in H; discriminate);
try (destruct (compare a a1) as [] eqn:?;
try (rewrite <- compare_antisym in Heqc0;
rewrite CompOpp_iff in Heqc0;
rewrite (compare_trans _ _ _  _ Heqc0 Heqc2) in Heqc1;
discriminate);
try (rewrite <- compare_antisym in Heqc1;
rewrite CompOpp_iff in Heqc1;
rewrite (compare_trans _ _ _ _ Heqc2 Heqc1) in Heqc0;
discriminate);
assumption);
rewrite (compare_trans _ _ _ _ Heqc0 Heqc1);
try assumption.
apply (compare_trans _ _ _ _ H H0).
Qed.
(** Special case of comparable, where equality is usual equality. **)
Class ComparableUsualEq {A:Type} (C: Comparable A) :=
compare_eq : forall x y, compare x y = Eq -> x = y.
(** Boolean equality for a [Comparable]. **)
Definition compare_eqb {A:Type} {C:Comparable A} (x y:A) :=
match compare x y with
| Eq => true
| _ => false
end.

(* Specifications: *)
Theorem compare_eqb_iff {A:Type} {C:Comparable A} {U:ComparableUsualEq C} :
forall x y, compare_eqb x y = true <-> x = y.