Fixpoint fin_compare (n : nat) :
forall (x y : fin n), { cmp : comparison | CompSpec eq fin_lt x y cmp } :=
match n with
| 0 => fun x y : fin 0 => match x with end
| S n' => fun x y : fin (S n') =>
match x, y with
| Some x', Some y' =>
match fin_compare n' x' y' with
| exist _ Lt Hc => exist _ Lt (CompLt _ _ (fin_lt_Some_intro (CompSpec_Lt Hc)))
| exist _ Eq Hc => exist _ Eq (CompEq _ _ (CompSpec_Eq_Some Hc))
| exist _ Gt Hc => exist _ Gt (CompGt _ _ (fin_lt_Some_intro (CompSpec_Gt Hc)))
end
| Some x', None => exist _ Gt (CompGt _ _ (None_lt_Some n' x'))
| None, Some y' => exist _ Lt (CompLt _ _ (None_lt_Some n' y'))
| None, None => exist _ Eq (CompEq _ _ eq_refl)
end
end.
Module fin_OT (Import N : NatValue) <: UsualOrderedType.
Definition t := fin n.
Definition eq := @eq (fin n).
Definition eq_equiv := @eq_equivalence (fin n).
Definition lt := @fin_lt n.
Definition lt_strorder := fin_lt_strorder n.
Definition lt_compat := fin_lt_lt_compat n.
Definition compare := fun x y => proj1_sig (fin_compare n x y).
Definition compare_spec := fun x y => proj2_sig (fin_compare n x y).
Definition eq_dec := fin_eq_dec n.
End fin_OT.
Fixpoint fin_of_nat (m n : nat) : fin n + {exists p, m = n + p} :=
match n with
| 0 => inright (ex_intro _ _ eq_refl)
| S n' =>
match m with
| 0 => inleft None
| S m' =>
match fin_of_nat m' n' with
| inleft f => inleft (Some f)
| inright pf =>
inright (match pf with
| ex_intro _ x H => ex_intro _ x (f_equal _ H)
end)
end
end
end.

(* Specifications: *)
Lemma fin_of_nat_fin_to_nat :
forall (n : nat) (a : fin n),
fin_of_nat (fin_to_nat a) n = inleft a.