(** Comparison  [Some c] means ordered as per [c]; [None] means unordered. *)
Definition Bcompare (f1 f2 : binary_float) : option comparison :=
match f1, f2 with
| B754_nan _ _,_ | _,B754_nan _ _ => None
| B754_infinity true, B754_infinity true
| B754_infinity false, B754_infinity false => Some Eq
| B754_infinity true, _ => Some Lt
| B754_infinity false, _ => Some Gt
| _, B754_infinity true => Some Gt
| _, B754_infinity false => Some Lt
| B754_finite true _ _ _, B754_zero _ => Some Lt
| B754_finite false _ _ _, B754_zero _ => Some Gt
| B754_zero _, B754_finite true _ _ _ => Some Gt
| B754_zero _, B754_finite false _ _ _ => Some Lt
| B754_zero _, B754_zero _ => Some Eq
| B754_finite s1 m1 e1 _, B754_finite s2 m2 e2 _ =>
match s1, s2 with
| true, false => Some Lt
| false, true => Some Gt
| false, false =>
match Zcompare e1 e2 with
| Lt => Some Lt
| Gt => Some Gt
| Eq => Some (Pcompare m1 m2 Eq)
end
| true, true =>
match Zcompare e1 e2 with
| Lt => Some Gt
| Gt => Some Lt
| Eq => Some (CompOpp (Pcompare m1 m2 Eq))
end
end
end.

Theorem Bcompare_correct :
forall f1 f2,
is_finite f1 = true -> is_finite f2 = true ->
Bcompare f1 f2 = Some (Rcompare (B2R f1) (B2R f2)).