Proof with auto with typeclass_instances.
intros m mx ez szero.
destruct mx as [|mz|mz] ; simpl.
rewrite F2R_0, round_0, Rabs_R0, Rlt_bool_true...
split... split...
rewrite Rcompare_Eq...
apply bpow_gt_0.
(* . mz > 0 *)
generalize (binary_round_correct m false mz ez).
simpl.
case Rlt_bool_spec.
intros _ (Vz, (Rz, (Rz', Rz''))).
split.
now rewrite B2R_FF2B.
split.
now rewrite is_finite_FF2B.
rewrite Bsign_FF2B, Rz''.
rewrite Rcompare_Gt...
apply F2R_gt_0_compat.
simpl. zify; omega.
intros Hz' (Vz, Rz).
rewrite B2FF_FF2B, Rz.
apply f_equal.
apply sym_eq.
apply Rlt_bool_false.
now apply F2R_ge_0_compat.
(* . mz < 0 *)
generalize (binary_round_correct m true mz ez).
simpl.
case Rlt_bool_spec.
intros _ (Vz, (Rz, (Rz', Rz''))).
split.
now rewrite B2R_FF2B.
split.
now rewrite is_finite_FF2B.
rewrite Bsign_FF2B, Rz''.
rewrite Rcompare_Lt...
apply F2R_lt_0_compat.
simpl. zify; omega.
intros Hz' (Vz, Rz).
rewrite B2FF_FF2B, Rz.
apply f_equal.
apply sym_eq.
apply Rlt_bool_true.
now apply F2R_lt_0_compat.
Qed.
(** Addition *)
Definition Bplus plus_nan m x y :=
let f pl := B754_nan (fst pl) (snd pl) in
match x, y with
| B754_nan _ _, _ | _, B754_nan _ _ => f (plus_nan x y)
| B754_infinity sx, B754_infinity sy =>
if Bool.eqb sx sy then x else f (plus_nan x y)
| B754_infinity _, _ => x
| _, B754_infinity _ => y
| B754_zero sx, B754_zero sy =>
if Bool.eqb sx sy then x else
match m with mode_DN => B754_zero true | _ => B754_zero false end
| B754_zero _, _ => y
| _, B754_zero _ => x
| B754_finite sx mx ex Hx, B754_finite sy my ey Hy =>
let ez := Zmin ex ey in
binary_normalize m (Zplus (cond_Zopp sx (Zpos (fst (shl_align mx ex ez)))) (cond_Zopp sy (Zpos (fst (shl_align my ey ez)))))
ez (match m with mode_DN => true | _ => false end)
end.

(* Specifications: *)
Theorem Bplus_correct :
forall plus_nan m x y,
is_finite x = true ->
is_finite y = true ->
if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x + B2R y))) (bpow radix2 emax) then
B2R (Bplus plus_nan m x y) = round radix2 fexp (round_mode m) (B2R x + B2R y) /\
is_finite (Bplus plus_nan m x y) = true /\
Bsign (Bplus plus_nan m x y) =
match Rcompare (B2R x + B2R y) 0 with
| Eq => match m with mode_DN => orb (Bsign x) (Bsign y)
| _ => andb (Bsign x) (Bsign y) end
| Lt => true
| Gt => false
end
else
(B2FF (Bplus plus_nan m x y) = binary_overflow m (Bsign x) /\ Bsign x = Bsign y).
Theorem Bplus_correct :
forall plus_nan m x y,
is_finite x = true ->
is_finite y = true ->
if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x + B2R y))) (bpow radix2 emax) then
B2R (Bplus plus_nan m x y) = round radix2 fexp (round_mode m) (B2R x + B2R y) /\
is_finite (Bplus plus_nan m x y) = true /\
Bsign (Bplus plus_nan m x y) =
match Rcompare (B2R x + B2R y) 0 with
| Eq => match m with mode_DN => orb (Bsign x) (Bsign y)
| _ => andb (Bsign x) (Bsign y) end
| Lt => true
| Gt => false
end
else
(B2FF (Bplus plus_nan m x y) = binary_overflow m (Bsign x) /\ Bsign x = Bsign y).