(** 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.

(* Specifications: *)
Theorem Bcompare_correct :
forall f1 f2,
is_finite f1 = true -> is_finite f2 = true ->
Bcompare f1 f2 = Some (Rcompare (B2R f1) (B2R f2)).
Theorem Bcompare_swap :
forall x y,
Bcompare y x = match Bcompare x y with Some c => Some (CompOpp c) | None => None end.
Theorem bounded_lt_emax :
forall mx ex,
bounded mx ex = true ->
(F2R (Float radix2 (Zpos mx) ex) < bpow radix2 emax)%R.
Theorem abs_B2R_lt_emax :
forall x,
(Rabs (B2R x) < bpow radix2 emax)%R.
Theorem bounded_canonic_lt_emax :
forall mx ex,
canonic radix2 fexp (Float radix2 (Zpos mx) ex) ->
(F2R (Float radix2 (Zpos mx) ex) < bpow radix2 emax)%R ->
bounded mx ex = true.