Commit 21e92c6a authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan Committed by Guillaume Melquiond

Add support for NaN payload.

parent 07c3c8c2
...@@ -33,7 +33,7 @@ Section AnyRadix. ...@@ -33,7 +33,7 @@ Section AnyRadix.
Inductive full_float := Inductive full_float :=
| F754_zero : bool -> full_float | F754_zero : bool -> full_float
| F754_infinity : bool -> full_float | F754_infinity : bool -> full_float
| F754_nan : full_float | F754_nan : bool -> positive -> full_float
| F754_finite : bool -> positive -> Z -> full_float. | F754_finite : bool -> positive -> Z -> full_float.
Definition FF2R beta x := Definition FF2R beta x :=
...@@ -67,16 +67,20 @@ Definition bounded m e := ...@@ -67,16 +67,20 @@ Definition bounded m e :=
Definition valid_binary x := Definition valid_binary x :=
match x with match x with
| F754_finite _ m e => bounded m e | F754_finite _ m e => bounded m e
| F754_nan _ pl => (Z_of_nat' (S (digits2_Pnat pl)) <? prec)%Z
| _ => true | _ => true
end. end.
(** Basic type used for representing binary FP numbers. (** Basic type used for representing binary FP numbers.
Note that there is exactly one such object per FP datum. Note that there is exactly one such object per FP datum.
NaNs do not have any payload. They cannot be distinguished. *) NaNs do not have any payload. They cannot be distinguished. *)
Definition nan_pl := {pl | (Z_of_nat' (S (digits2_Pnat pl)) <? prec)%Z = true}.
Inductive binary_float := Inductive binary_float :=
| B754_zero : bool -> binary_float | B754_zero : bool -> binary_float
| B754_infinity : bool -> binary_float | B754_infinity : bool -> binary_float
| B754_nan : binary_float | B754_nan : bool -> nan_pl -> binary_float
| B754_finite : bool -> | B754_finite : bool ->
forall (m : positive) (e : Z), bounded m e = true -> binary_float. forall (m : positive) (e : Z), bounded m e = true -> binary_float.
...@@ -85,7 +89,7 @@ Definition FF2B x := ...@@ -85,7 +89,7 @@ Definition FF2B x :=
| F754_finite s m e => B754_finite s m e | F754_finite s m e => B754_finite s m e
| F754_infinity s => fun _ => B754_infinity s | F754_infinity s => fun _ => B754_infinity s
| F754_zero s => fun _ => B754_zero s | F754_zero s => fun _ => B754_zero s
| F754_nan => fun _ => B754_nan | F754_nan b pl => fun H => B754_nan b (exist _ pl H)
end. end.
Definition B2FF x := Definition B2FF x :=
...@@ -93,7 +97,7 @@ Definition B2FF x := ...@@ -93,7 +97,7 @@ Definition B2FF x :=
| B754_finite s m e _ => F754_finite s m e | B754_finite s m e _ => F754_finite s m e
| B754_infinity s => F754_infinity s | B754_infinity s => F754_infinity s
| B754_zero s => F754_zero s | B754_zero s => F754_zero s
| B754_nan => F754_nan | B754_nan b (exist pl _) => F754_nan b pl
end. end.
Definition radix2 := Build_radix 2 (refl_equal true). Definition radix2 := Build_radix 2 (refl_equal true).
...@@ -108,30 +112,30 @@ Theorem FF2R_B2FF : ...@@ -108,30 +112,30 @@ Theorem FF2R_B2FF :
forall x, forall x,
FF2R radix2 (B2FF x) = B2R x. FF2R radix2 (B2FF x) = B2R x.
Proof. Proof.
now intros [sx|sx| |sx mx ex Hx]. now intros [sx|sx|sx [plx Hplx]|sx mx ex Hx].
Qed. Qed.
Theorem B2FF_FF2B : Theorem B2FF_FF2B :
forall x Hx, forall x Hx,
B2FF (FF2B x Hx) = x. B2FF (FF2B x Hx) = x.
Proof. Proof.
now intros [sx|sx| |sx mx ex] Hx. now intros [sx|sx|sx plx|sx mx ex] Hx.
Qed. Qed.
Theorem valid_binary_B2FF : Theorem valid_binary_B2FF :
forall x, forall x,
valid_binary (B2FF x) = true. valid_binary (B2FF x) = true.
Proof. Proof.
now intros [sx|sx| |sx mx ex Hx]. now intros [sx|sx|sx [plx Hplx]|sx mx ex Hx].
Qed. Qed.
Theorem FF2B_B2FF : Theorem FF2B_B2FF :
forall x H, forall x H,
FF2B (B2FF x) H = x. FF2B (B2FF x) H = x.
Proof. Proof.
intros [sx|sx| |sx mx ex Hx] H ; try easy. intros [sx|sx|sx [plx Hplx]|sx mx ex Hx] H ; try easy.
apply f_equal. simpl. apply f_equal, f_equal, eqbool_irrelevance.
apply eqbool_irrelevance. apply f_equal, eqbool_irrelevance.
Qed. Qed.
Theorem FF2B_B2FF_valid : Theorem FF2B_B2FF_valid :
...@@ -146,7 +150,7 @@ Theorem B2R_FF2B : ...@@ -146,7 +150,7 @@ Theorem B2R_FF2B :
forall x Hx, forall x Hx,
B2R (FF2B x Hx) = FF2R radix2 x. B2R (FF2B x Hx) = FF2R radix2 x.
Proof. Proof.
now intros [sx|sx| |sx mx ex] Hx. now intros [sx|sx|sx plx|sx mx ex] Hx.
Qed. Qed.
Theorem match_FF2B : Theorem match_FF2B :
...@@ -154,17 +158,17 @@ Theorem match_FF2B : ...@@ -154,17 +158,17 @@ Theorem match_FF2B :
match FF2B x Hx return T with match FF2B x Hx return T with
| B754_zero sx => fz sx | B754_zero sx => fz sx
| B754_infinity sx => fi sx | B754_infinity sx => fi sx
| B754_nan => fn | B754_nan b (exist p _) => fn b p
| B754_finite sx mx ex _ => ff sx mx ex | B754_finite sx mx ex _ => ff sx mx ex
end = end =
match x with match x with
| F754_zero sx => fz sx | F754_zero sx => fz sx
| F754_infinity sx => fi sx | F754_infinity sx => fi sx
| F754_nan => fn | F754_nan b p => fn b p
| F754_finite sx mx ex => ff sx mx ex | F754_finite sx mx ex => ff sx mx ex
end. end.
Proof. Proof.
now intros T fz fi fn ff [sx|sx| |sx mx ex] Hx. now intros T fz fi fn ff [sx|sx|sx plx|sx mx ex] Hx.
Qed. Qed.
Theorem canonic_canonic_mantissa : Theorem canonic_canonic_mantissa :
...@@ -189,7 +193,7 @@ Theorem generic_format_B2R : ...@@ -189,7 +193,7 @@ Theorem generic_format_B2R :
forall x, forall x,
generic_format radix2 fexp (B2R x). generic_format radix2 fexp (B2R x).
Proof. Proof.
intros [sx|sx| |sx mx ex Hx] ; try apply generic_format_0. intros [sx|sx|sx plx|sx mx ex Hx] ; try apply generic_format_0.
simpl. simpl.
apply generic_format_canonic. apply generic_format_canonic.
apply canonic_canonic_mantissa. apply canonic_canonic_mantissa.
...@@ -210,7 +214,7 @@ Theorem B2FF_inj : ...@@ -210,7 +214,7 @@ Theorem B2FF_inj :
B2FF x = B2FF y -> B2FF x = B2FF y ->
x = y. x = y.
Proof. Proof.
intros [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] ; try easy. intros [sx|sx|sx [plx Hplx]|sx mx ex Hx] [sy|sy|sy [ply Hply]|sy my ey Hy] ; try easy.
(* *) (* *)
intros H. intros H.
now inversion H. now inversion H.
...@@ -221,11 +225,18 @@ now inversion H. ...@@ -221,11 +225,18 @@ now inversion H.
intros H. intros H.
inversion H. inversion H.
clear H. clear H.
revert Hplx.
rewrite H2.
intros Hx.
apply f_equal, f_equal, eqbool_irrelevance.
(* *)
intros H.
inversion H.
clear H.
revert Hx. revert Hx.
rewrite H2, H3. rewrite H2, H3.
intros Hx. intros Hx.
apply f_equal. apply f_equal, eqbool_irrelevance.
apply eqbool_irrelevance.
Qed. Qed.
Definition is_finite_strict f := Definition is_finite_strict f :=
...@@ -299,37 +310,71 @@ Theorem is_finite_FF_B2FF : ...@@ -299,37 +310,71 @@ Theorem is_finite_FF_B2FF :
forall x, forall x,
is_finite_FF (B2FF x) = is_finite x. is_finite_FF (B2FF x) = is_finite x.
Proof. Proof.
now intros [| |? []|].
Qed.
Definition is_nan f :=
match f with
| B754_nan _ _ => true
| _ => false
end.
Definition is_nan_FF f :=
match f with
| F754_nan _ _ => true
| _ => false
end.
Theorem is_nan_FF2B :
forall x Hx,
is_nan (FF2B x Hx) = is_nan_FF x.
Proof.
now intros [| | |]. now intros [| | |].
Qed. Qed.
Definition Bopp x := Theorem is_nan_FF_B2FF :
forall x,
is_nan_FF (B2FF x) = is_nan x.
Proof.
now intros [| |? []|].
Qed.
Definition Bopp opp_nan x :=
match x with match x with
| B754_nan => x | B754_nan sx plx =>
let '(sres, plres) := opp_nan sx plx in B754_nan sres plres
| B754_infinity sx => B754_infinity (negb sx) | B754_infinity sx => B754_infinity (negb sx)
| B754_finite sx mx ex Hx => B754_finite (negb sx) mx ex Hx | B754_finite sx mx ex Hx => B754_finite (negb sx) mx ex Hx
| B754_zero sx => B754_zero (negb sx) | B754_zero sx => B754_zero (negb sx)
end. end.
Theorem Bopp_involutive : Theorem Bopp_involutive :
forall x, Bopp (Bopp x) = x. forall opp_nan x,
is_nan x = false ->
Bopp opp_nan (Bopp opp_nan x) = x.
Proof. Proof.
now intros [sx|sx| |sx mx ex Hx] ; simpl ; try rewrite Bool.negb_involutive. now intros opp_nan [sx|sx|sx plx|sx mx ex Hx] ; simpl ; try rewrite Bool.negb_involutive.
Qed. Qed.
Theorem B2R_Bopp : Theorem B2R_Bopp :
forall x, forall opp_nan x,
B2R (Bopp x) = (- B2R x)%R. B2R (Bopp opp_nan x) = (- B2R x)%R.
Proof. Proof.
intros [sx|sx| |sx mx ex Hx] ; apply sym_eq ; try apply Ropp_0. intros opp_nan [sx|sx|sx plx|sx mx ex Hx]; apply sym_eq ; try apply Ropp_0.
simpl. destruct opp_nan. apply Ropp_0.
simpl. simpl.
rewrite <- F2R_opp. rewrite <- F2R_opp.
now case sx. now case sx.
Qed. Qed.
Theorem is_finite_Bopp: forall x, Theorem is_finite_Bopp :
is_finite (Bopp x) = is_finite x. forall opp_nan x,
is_finite (Bopp opp_nan x) = is_finite x.
Proof. Proof.
now intros [| | |]. intros opp_nan [| | |] ; try easy.
intros s pl.
simpl.
now case opp_nan.
Qed. Qed.
Theorem bounded_lt_emax : Theorem bounded_lt_emax :
...@@ -367,7 +412,7 @@ Theorem abs_B2R_lt_emax : ...@@ -367,7 +412,7 @@ Theorem abs_B2R_lt_emax :
forall x, forall x,
(Rabs (B2R x) < bpow radix2 emax)%R. (Rabs (B2R x) < bpow radix2 emax)%R.
Proof. Proof.
intros [sx|sx| |sx mx ex Hx] ; simpl ; try ( rewrite Rabs_R0 ; apply bpow_gt_0 ). intros [sx|sx|sx plx|sx mx ex Hx] ; simpl ; try ( rewrite Rabs_R0 ; apply bpow_gt_0 ).
rewrite <- F2R_Zabs, abs_cond_Zopp. rewrite <- F2R_Zabs, abs_cond_Zopp.
now apply bounded_lt_emax. now apply bounded_lt_emax.
Qed. Qed.
...@@ -644,7 +689,7 @@ Definition binary_round_aux mode sx mx ex lx := ...@@ -644,7 +689,7 @@ Definition binary_round_aux mode sx mx ex lx :=
match shr_m mrs'' with match shr_m mrs'' with
| Z0 => F754_zero sx | Z0 => F754_zero sx
| Zpos m => if Zle_bool e'' (emax - prec) then F754_finite sx m e'' else binary_overflow mode sx | Zpos m => if Zle_bool e'' (emax - prec) then F754_finite sx m e'' else binary_overflow mode sx
| _ => F754_nan (* dummy *) | _ => F754_nan false xH (* dummy *)
end. end.
Theorem binary_round_aux_correct : Theorem binary_round_aux_correct :
...@@ -826,7 +871,7 @@ Qed. ...@@ -826,7 +871,7 @@ Qed.
Definition Bsign x := Definition Bsign x :=
match x with match x with
| B754_nan => false | B754_nan s _ => s
| B754_zero s => s | B754_zero s => s
| B754_infinity s => s | B754_infinity s => s
| B754_finite s _ _ _ => s | B754_finite s _ _ _ => s
...@@ -834,7 +879,7 @@ Definition Bsign x := ...@@ -834,7 +879,7 @@ Definition Bsign x :=
Definition sign_FF x := Definition sign_FF x :=
match x with match x with
| F754_nan => false | F754_nan s _ => s
| F754_zero s => s | F754_zero s => s
| F754_infinity s => s | F754_infinity s => s
| F754_finite s _ _ => s | F754_finite s _ _ => s
...@@ -844,7 +889,7 @@ Theorem Bsign_FF2B : ...@@ -844,7 +889,7 @@ Theorem Bsign_FF2B :
forall x H, forall x H,
Bsign (FF2B x H) = sign_FF x. Bsign (FF2B x H) = sign_FF x.
Proof. Proof.
now intros [sx|sx| |sx mx ex] H. now intros [sx|sx|sx plx|sx mx ex] H.
Qed. Qed.
(** Multiplication *) (** Multiplication *)
...@@ -902,15 +947,15 @@ apply Rlt_bool_false. ...@@ -902,15 +947,15 @@ apply Rlt_bool_false.
now apply F2R_ge_0_compat. now apply F2R_ge_0_compat.
Qed. Qed.
Definition Bmult m x y := Definition Bmult mult_nan m x y :=
let f pl := B754_nan (fst pl) (snd pl) in
match x, y with match x, y with
| B754_nan, _ => x | B754_nan _ _, _ | _, B754_nan _ _ => f (mult_nan x y)
| _, B754_nan => y
| B754_infinity sx, B754_infinity sy => B754_infinity (xorb sx sy) | B754_infinity sx, B754_infinity sy => B754_infinity (xorb sx sy)
| B754_infinity sx, B754_finite sy _ _ _ => B754_infinity (xorb sx sy) | B754_infinity sx, B754_finite sy _ _ _ => B754_infinity (xorb sx sy)
| B754_finite sx _ _ _, B754_infinity sy => B754_infinity (xorb sx sy) | B754_finite sx _ _ _, B754_infinity sy => B754_infinity (xorb sx sy)
| B754_infinity _, B754_zero _ => B754_nan | B754_infinity _, B754_zero _ => f (mult_nan x y)
| B754_zero _, B754_infinity _ => B754_nan | B754_zero _, B754_infinity _ => f (mult_nan x y)
| B754_finite sx _ _ _, B754_zero sy => B754_zero (xorb sx sy) | B754_finite sx _ _ _, B754_zero sy => B754_zero (xorb sx sy)
| B754_zero sx, B754_finite sy _ _ _ => B754_zero (xorb sx sy) | B754_zero sx, B754_finite sy _ _ _ => B754_zero (xorb sx sy)
| B754_zero sx, B754_zero sy => B754_zero (xorb sx sy) | B754_zero sx, B754_zero sy => B754_zero (xorb sx sy)
...@@ -919,14 +964,14 @@ Definition Bmult m x y := ...@@ -919,14 +964,14 @@ Definition Bmult m x y :=
end. end.
Theorem Bmult_correct : Theorem Bmult_correct :
forall m x y, forall mult_nan m x y,
if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x * B2R y))) (bpow radix2 emax) then if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x * B2R y))) (bpow radix2 emax) then
B2R (Bmult m x y) = round radix2 fexp (round_mode m) (B2R x * B2R y) /\ B2R (Bmult mult_nan m x y) = round radix2 fexp (round_mode m) (B2R x * B2R y) /\
is_finite (Bmult m x y) = andb (is_finite x) (is_finite y) is_finite (Bmult mult_nan m x y) = andb (is_finite x) (is_finite y)
else else
B2FF (Bmult m x y) = binary_overflow m (xorb (Bsign x) (Bsign y)). B2FF (Bmult mult_nan m x y) = binary_overflow m (xorb (Bsign x) (Bsign y)).
Proof. Proof.
intros m [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] ; intros mult_nan m [sx|sx|sx plx|sx mx ex Hx] [sy|sy|sy ply|sy my ey Hy] ;
try ( rewrite ?Rmult_0_r, ?Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ split ; apply refl_equal | apply bpow_gt_0 | auto with typeclass_instances ] ). try ( rewrite ?Rmult_0_r, ?Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ split ; apply refl_equal | apply bpow_gt_0 | auto with typeclass_instances ] ).
simpl. simpl.
case Bmult_correct_aux. case Bmult_correct_aux.
...@@ -940,15 +985,15 @@ intros H2. ...@@ -940,15 +985,15 @@ intros H2.
now rewrite B2FF_FF2B. now rewrite B2FF_FF2B.
Qed. Qed.
Definition Bmult_FF m x y := Definition Bmult_FF mult_nan m x y :=
let f pl := F754_nan (fst pl) (snd pl) in
match x, y with match x, y with
| F754_nan, _ => x | F754_nan _ _, _ | _, F754_nan _ _ => f (mult_nan x y)
| _, F754_nan => y
| F754_infinity sx, F754_infinity sy => F754_infinity (xorb sx sy) | F754_infinity sx, F754_infinity sy => F754_infinity (xorb sx sy)
| F754_infinity sx, F754_finite sy _ _ => F754_infinity (xorb sx sy) | F754_infinity sx, F754_finite sy _ _ => F754_infinity (xorb sx sy)
| F754_finite sx _ _, F754_infinity sy => F754_infinity (xorb sx sy) | F754_finite sx _ _, F754_infinity sy => F754_infinity (xorb sx sy)
| F754_infinity _, F754_zero _ => F754_nan | F754_infinity _, F754_zero _ => f (mult_nan x y)
| F754_zero _, F754_infinity _ => F754_nan | F754_zero _, F754_infinity _ => f (mult_nan x y)
| F754_finite sx _ _, F754_zero sy => F754_zero (xorb sx sy) | F754_finite sx _ _, F754_zero sy => F754_zero (xorb sx sy)
| F754_zero sx, F754_finite sy _ _ => F754_zero (xorb sx sy) | F754_zero sx, F754_finite sy _ _ => F754_zero (xorb sx sy)
| F754_zero sx, F754_zero sy => F754_zero (xorb sx sy) | F754_zero sx, F754_zero sy => F754_zero (xorb sx sy)
...@@ -957,14 +1002,20 @@ Definition Bmult_FF m x y := ...@@ -957,14 +1002,20 @@ Definition Bmult_FF m x y :=
end. end.
Theorem B2FF_Bmult : Theorem B2FF_Bmult :
forall mult_nan mult_nan_ff,
forall m x y, forall m x y,
B2FF (Bmult m x y) = Bmult_FF m (B2FF x) (B2FF y). mult_nan_ff (B2FF x) (B2FF y) = (let '(sr, exist plr _) := mult_nan x y in (sr, plr)) ->
B2FF (Bmult mult_nan m x y) = Bmult_FF mult_nan_ff m (B2FF x) (B2FF y).
Proof. Proof.
intros m [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] ; try easy. intros mult_nan mult_nan_ff m x y Hmult_nan.
unfold Bmult_FF. rewrite Hmult_nan.
destruct x as [sx|sx|sx [plx Hplx]|sx mx ex Hx], y as [sy|sy|sy [ply Hply]|sy my ey Hy] ;
simpl; try match goal with |- context [mult_nan ?x ?y] =>
destruct (mult_nan x y) as [? []] end;
try easy.
apply B2FF_FF2B. apply B2FF_FF2B.
Qed. Qed.
Definition shl_align mx ex ex' := Definition shl_align mx ex ex' :=
match (ex' - ex)%Z with match (ex' - ex)%Z with
| Zneg d => (shift_pos d mx, ex') | Zneg d => (shift_pos d mx, ex')
...@@ -1129,12 +1180,12 @@ now apply F2R_lt_0_compat. ...@@ -1129,12 +1180,12 @@ now apply F2R_lt_0_compat.
Qed. Qed.
(** Addition *) (** Addition *)
Definition Bplus m x y := Definition Bplus plus_nan m x y :=
let f pl := B754_nan (fst pl) (snd pl) in
match x, y with match x, y with
| B754_nan, _ => x | B754_nan _ _, _ | _, B754_nan _ _ => f (plus_nan x y)
| _, B754_nan => y
| B754_infinity sx, B754_infinity sy => | B754_infinity sx, B754_infinity sy =>
if Bool.eqb sx sy then x else B754_nan if Bool.eqb sx sy then x else f (plus_nan x y)
| B754_infinity _, _ => x | B754_infinity _, _ => x
| _, B754_infinity _ => y | _, B754_infinity _ => y
| B754_zero sx, B754_zero sy => | B754_zero sx, B754_zero sy =>
...@@ -1149,16 +1200,16 @@ Definition Bplus m x y := ...@@ -1149,16 +1200,16 @@ Definition Bplus m x y :=
end. end.
Theorem Bplus_correct : Theorem Bplus_correct :
forall m x y, forall plus_nan m x y,
is_finite x = true -> is_finite x = true ->
is_finite y = true -> is_finite y = true ->
if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x + B2R y))) (bpow radix2 emax) then if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x + B2R y))) (bpow radix2 emax) then
B2R (Bplus m x y) = round radix2 fexp (round_mode m) (B2R x + B2R y) /\ B2R (Bplus plus_nan m x y) = round radix2 fexp (round_mode m) (B2R x + B2R y) /\
is_finite (Bplus m x y) = true is_finite (Bplus plus_nan m x y) = true
else else
(B2FF (Bplus m x y) = binary_overflow m (Bsign x) /\ Bsign x = Bsign y). (B2FF (Bplus plus_nan m x y) = binary_overflow m (Bsign x) /\ Bsign x = Bsign y).
Proof with auto with typeclass_instances. Proof with auto with typeclass_instances.
intros m [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] Fx Fy ; try easy. intros plus_nan m [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] Fx Fy ; try easy.
(* *) (* *)
rewrite Rplus_0_r, round_0, Rabs_R0, Rlt_bool_true... rewrite Rplus_0_r, round_0, Rabs_R0, Rlt_bool_true...
simpl. simpl.
...@@ -1279,26 +1330,25 @@ now apply f_equal. ...@@ -1279,26 +1330,25 @@ now apply f_equal.
apply Sz. apply Sz.
Qed. Qed.
Definition Bminus m x y := Bplus m x (Bopp y). Definition Bminus minus_nan m x y := Bplus minus_nan m x (Bopp pair y).
Theorem Bminus_correct : Theorem Bminus_correct :
forall m x y, forall minus_nan m x y,
is_finite x = true -> is_finite x = true ->
is_finite y = true -> is_finite y = true ->
if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x - B2R y))) (bpow radix2 emax) then if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x - B2R y))) (bpow radix2 emax) then
B2R (Bminus m x y) = round radix2 fexp (round_mode m) (B2R x - B2R y) /\ B2R (Bminus minus_nan m x y) = round radix2 fexp (round_mode m) (B2R x - B2R y) /\
is_finite (Bminus m x y) = true is_finite (Bminus minus_nan m x y) = true
else else
(B2FF (Bminus m x y) = binary_overflow m (Bsign x) /\ Bsign x = negb (Bsign y)). (B2FF (Bminus minus_nan m x y) = binary_overflow m (Bsign x) /\ Bsign x = negb (Bsign y)).
Proof with auto with typeclass_instances. Proof with auto with typeclass_instances.
intros m x y Fx Fy. intros m minus_nan x y Fx Fy.
replace (negb (Bsign y)) with (Bsign (Bopp y)). replace (negb (Bsign y)) with (Bsign (Bopp pair y)).
unfold Rminus. unfold Rminus.
rewrite <- B2R_Bopp. erewrite <- B2R_Bopp.
apply Bplus_correct. apply Bplus_correct.
exact Fx. exact Fx.
now rewrite is_finite_Bopp. rewrite is_finite_Bopp. auto. now destruct y as [ | | | ].
now destruct y as [ | | | ].
Qed. Qed.
(** Division *) (** Division *)
...@@ -1322,7 +1372,7 @@ Lemma Bdiv_correct_aux : ...@@ -1322,7 +1372,7 @@ Lemma Bdiv_correct_aux :
let '(mz, ez, lz) := Fdiv_core_binary (Zpos mx) ex (Zpos my) ey in let '(mz, ez, lz) := Fdiv_core_binary (Zpos mx) ex (Zpos my) ey in
match mz with match mz with
| Zpos mz => binary_round_aux m (xorb sx sy) mz ez lz | Zpos mz => binary_round_aux m (xorb sx sy) mz ez lz
| _ => F754_nan (* dummy *) | _ => F754_nan false xH (* dummy *)
end in