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