Commit 0d67a5bf authored by Guillaume Melquiond's avatar Guillaume Melquiond

Make Fdiv_core generic with respect to format.

parent 9e2ea1b4
......@@ -116,7 +116,7 @@ Qed.
Lemma Rsgn_div :
forall x y : R,
x <> R0 -> y <> R0 ->
x <> 0%R -> y <> 0%R ->
Rlt_bool (x / y) 0 = xorb (Rlt_bool x 0) (Rlt_bool y 0).
Proof.
intros x y Hx0 Hy0.
......@@ -163,13 +163,13 @@ Definition div (x y : float beta) :=
let (my, ey) := y in
if Zeq_bool mx 0 then Float beta 0 0
else
let '(m, e, l) := truncate beta fexp (Fdiv_core beta prec (Zabs mx) ex (Zabs my) ey) in
let '(m, e, l) := truncate beta fexp (Fdiv_core beta fexp (Zabs mx) ex (Zabs my) ey) in
let s := xorb (Zlt_bool mx 0) (Zlt_bool my 0) in
Float beta (cond_Zopp s (choice s m l)) e.
Theorem div_correct :
forall x y : float beta,
F2R y <> R0 ->
F2R y <> 0%R ->
round beta fexp rnd (F2R x / F2R y) = F2R (div x y).
Proof.
intros [mx ex] [my ey] Hy.
......@@ -185,10 +185,10 @@ assert (Hy': (0 < Zabs my)%Z).
contradict Hy.
rewrite Hy.
apply F2R_0.
generalize (Fdiv_core_correct beta prec (Zabs mx) ex (Zabs my) ey Hprec Hx Hy').
generalize (Fdiv_core_correct beta fexp (Zabs mx) ex (Zabs my) ey Hx Hy').
destruct Fdiv_core as [[m e] l].
intros [Hs1 Hs2].
rewrite (round_trunc_sign_any_correct beta fexp rnd choice rnd_choice _ m e l).
rewrite (round_trunc_sign_any_correct' beta fexp rnd choice rnd_choice _ m e l).
destruct truncate as [[m' e'] l'].
apply (f_equal (fun s => F2R (Float beta (cond_Zopp s (choice s _ _)) _))).
rewrite Rsgn_div.
......@@ -202,8 +202,11 @@ rewrite <- 2!F2R_Zabs.
exact Hs2.
exact Hy.
left.
apply Zle_trans with (2 := fexp_prec _).
clear -Hs1 ; omega.
rewrite <- cexp_abs.
unfold Rdiv.
rewrite Rabs_mult, Rabs_Rinv.
now rewrite <- 2!F2R_Zabs.
exact Hy.
Qed.
End Compute.
......@@ -19,13 +19,15 @@ COPYING file for more details.
(** * Helper function and theorem for computing the rounded quotient of two floating-point numbers. *)
Require Import Raux Defs Float_prop Digits Bracket.
Require Import Raux Defs Generic_fmt Float_prop Digits Bracket.
Section Fcalc_div.
Variable beta : radix.
Notation bpow e := (bpow beta e).
Variable fexp : Z -> Z.
(** Computes a mantissa of precision p, the corresponding exponent,
and the position with respect to the real quotient of the
input floating-point numbers.
......@@ -38,98 +40,97 @@ The algorithm performs the following steps:
Complexity is fine as long as p1 <= 2p and p2 <= p.
*)
Definition Fdiv_core prec m1 e1 m2 e2 :=
Definition Fdiv_core m1 e1 m2 e2 :=
let d1 := Zdigits beta m1 in
let d2 := Zdigits beta m2 in
let e := (e1 - e2)%Z in
let (m, e') :=
match (d2 + prec - d1)%Z with
| Zpos p => (m1 * Zpower_pos beta p, e + Zneg p)%Z
| _ => (m1, e)
end in
let e' := (d1 + e1 - (d2 + e2))%Z in
let e := Zmin (Zmin (fexp e') (fexp (e' + 1))) (e1 - e2) in
let m := (m1 * Zpower beta (e1 - e2 - e))%Z in
let '(q, r) := Zdiv_eucl m m2 in
(q, e', new_location m2 r loc_Exact).
(q, e, new_location m2 r loc_Exact).
Theorem Fdiv_core_correct :
forall prec m1 e1 m2 e2,
(0 < prec)%Z ->
forall m1 e1 m2 e2,
(0 < m1)%Z -> (0 < m2)%Z ->
let '(m, e, l) := Fdiv_core prec m1 e1 m2 e2 in
(prec <= Zdigits beta m)%Z /\
let '(m, e, l) := Fdiv_core m1 e1 m2 e2 in
(e <= cexp beta fexp (F2R (Float beta m1 e1) / F2R (Float beta m2 e2)))%Z /\
inbetween_float beta m e (F2R (Float beta m1 e1) / F2R (Float beta m2 e2)) l.
Proof.
intros prec m1 e1 m2 e2 Hprec Hm1 Hm2.
intros m1 e1 m2 e2 Hm1 Hm2.
unfold Fdiv_core.
set (d1 := Zdigits beta m1).
set (d2 := Zdigits beta m2).
case_eq
(match (d2 + prec - d1)%Z with
| Zpos p => ((m1 * Zpower_pos beta p)%Z, (e1 - e2 + Zneg p)%Z)
| _ => (m1, (e1 - e2)%Z)
end).
intros m' e' Hme.
(* . the shifted mantissa m' has enough digits *)
assert (Hs: F2R (Float beta m' (e' + e2)) = F2R (Float beta m1 e1) /\ (0 < m')%Z /\ (d2 + prec <= Zdigits beta m')%Z).
replace (d2 + prec)%Z with (d2 + prec - d1 + d1)%Z by ring.
destruct (d2 + prec - d1)%Z as [|p|p] ;
unfold d1 ;
inversion Hme.
ring_simplify (e1 - e2 + e2)%Z.
repeat split.
now rewrite <- H0.
apply Zle_refl.
replace (e1 - e2 + Zneg p + e2)%Z with (e1 - Zpos p)%Z by (unfold Zminus ; simpl ; ring).
fold (Zpower beta (Zpos p)).
split.
pattern (Zpos p) at 1 ; replace (Zpos p) with (e1 - (e1 - Zpos p))%Z by ring.
apply sym_eq.
apply F2R_change_exp.
assert (0 < Zpos p)%Z by easy.
omega.
split.
apply Zmult_lt_0_compat.
exact Hm1.
now apply Zpower_gt_0.
rewrite Zdigits_mult_Zpower.
rewrite Zplus_comm.
apply Zle_refl.
apply sym_not_eq.
now apply Zlt_not_eq.
easy.
split.
now ring_simplify (e1 - e2 + e2)%Z.
assert (Zneg p < 0)%Z by easy.
omega.
(* . *)
destruct Hs as (Hs1, (Hs2, Hs3)).
rewrite <- Hs1.
set (e := (d1 + e1 - (d2 + e2))%Z).
set (e' := Zmin (Zmin (fexp e) (fexp (e + 1))) (e1 - e2)).
set (m' := (m1 * Zpower beta (e1 - e2 - e'))%Z).
assert (bpow (e - 1) < F2R (Float beta m1 e1) / F2R (Float beta m2 e2) < bpow (e + 1))%R as Hd.
{ unfold e, d1, d2.
rewrite <- (mag_F2R_Zdigits beta m1 e1) by now apply Zgt_not_eq.
rewrite <- (mag_F2R_Zdigits beta m2 e2) by now apply Zgt_not_eq.
destruct mag as [e1' He1].
destruct mag as [e2' He2].
simpl.
assert (bpow (e1' - 1) <= F2R (Float beta m1 e1) < bpow e1')%R as H1.
{ rewrite Rabs_pos_eq in He1.
now apply He1, F2R_neq_0, Zgt_not_eq.
now apply Rlt_le, F2R_gt_0. }
assert (bpow (e2' - 1) <= F2R (Float beta m2 e2) < bpow e2')%R as H2.
{ rewrite Rabs_pos_eq in He2.
now apply He2, F2R_neq_0, Zgt_not_eq.
now apply Rlt_le, F2R_gt_0. }
split.
- replace (e1' - e2' - 1)%Z with (e1' - 1 + -e2')%Z by ring.
rewrite bpow_plus, bpow_opp.
apply Rle_lt_trans with (F2R (Float beta m1 e1) * / bpow e2')%R.
apply Rmult_le_compat_r with (2 := proj1 H1).
apply Rlt_le, Rinv_0_lt_compat, bpow_gt_0.
apply Rmult_lt_compat_l.
now apply F2R_gt_0.
apply Rinv_lt with (2 := proj2 H2).
now apply F2R_gt_0.
- replace (e1' - e2' + 1)%Z with (e1' + -(e2' - 1))%Z by ring.
rewrite bpow_plus, bpow_opp.
apply Rle_lt_trans with (F2R (Float beta m1 e1) * / bpow (e2' - 1))%R.
apply Rmult_le_compat_l.
now apply F2R_ge_0, Zlt_le_weak.
apply Rinv_le with (2 := proj1 H2).
apply bpow_gt_0.
apply Rmult_lt_compat_r with (2 := proj2 H1).
apply Rinv_0_lt_compat, bpow_gt_0. }
assert (F2R (Float beta m1 e1) = F2R (Float beta m' (e' + e2))) as Hf1.
unfold m'.
replace (e1 - e2 - e')%Z with (e1 - (e' + e2))%Z by ring.
apply F2R_change_exp.
cut (e' <= e1 - e2)%Z. clear ; omega.
apply Z.le_min_r.
generalize (Z_div_mod m' m2 (Zlt_gt _ _ Hm2)).
destruct (Zdiv_eucl m' m2) as (q, r).
intros (Hq, Hr).
split.
(* . the result mantissa q has enough digits *)
cut (Zdigits beta m' <= d2 + Zdigits beta q)%Z. omega.
unfold d2.
rewrite Hq.
assert (Hq': (0 < q)%Z).
apply Zmult_lt_reg_r with (1 := Hm2).
assert (m2 < m')%Z.
apply lt_Zdigits with beta.
now apply Zlt_le_weak.
unfold d2 in Hs3.
clear -Hprec Hs3 ; omega.
cut (q * m2 = m' - r)%Z. clear -Hr H ; omega.
rewrite Hq.
ring.
apply Zle_trans with (Zdigits beta (m2 + q + m2 * q)).
apply Zdigits_le.
rewrite <- Hq.
now apply Zlt_le_weak.
clear -Hr Hq'. omega.
apply Zdigits_mult_strong ; apply Zlt_le_weak.
now apply Zle_lt_trans with r.
exact Hq'.
(* . the location is correctly computed *)
- apply Zle_trans with (1 := Zle_min_l _ _).
unfold cexp.
assert (e <= mag beta (F2R (Float beta m1 e1) / F2R (Float beta m2 e2)) <= e + 1)%Z as [H1 H2].
{ destruct Hd as [Hd1 Hd2].
assert (0 < F2R (Float beta m1 e1) / F2R (Float beta m2 e2))%R as H.
apply Rmult_lt_0_compat.
now apply F2R_gt_0.
now apply Rinv_0_lt_compat, F2R_gt_0.
split.
- apply mag_ge_bpow.
rewrite Rabs_pos_eq ; now apply Rlt_le.
- apply mag_le_bpow.
now apply Rgt_not_eq.
rewrite Rabs_pos_eq.
exact Hd2.
now apply Rlt_le. }
destruct (Zle_lt_or_eq _ _ H1) as [H|H].
+ replace (fexp (mag _ _)) with (fexp (e + 1)).
apply Zle_min_r.
clear -H1 H2 H ; apply f_equal ; omega.
+ replace (fexp (mag _ _)) with (fexp e).
apply Zle_min_l.
clear -H1 H2 H ; apply f_equal ; omega.
- rewrite Hf1.
unfold inbetween_float, F2R. simpl.
rewrite bpow_plus, plus_IZR.
rewrite Hq, plus_IZR, mult_IZR.
......
......@@ -909,7 +909,7 @@ Definition binary_overflow m s :=
else F754_finite s (match (Zpower 2 prec - 1)%Z with Zpos p => p | _ => xH end) (emax - prec).
Definition binary_round_aux mode sx mx ex lx :=
let '(mrs', e') := shr_fexp (Zpos mx) ex lx in
let '(mrs', e') := shr_fexp mx ex lx in
let '(mrs'', e'') := shr_fexp (choice_mode mode sx (shr_m mrs') (loc_of_shr_record mrs')) e' loc_Exact in
match shr_m mrs'' with
| Z0 => F754_zero sx
......@@ -919,7 +919,8 @@ Definition binary_round_aux mode sx mx ex lx :=
Theorem binary_round_aux_correct' :
forall mode x mx ex lx,
inbetween_float radix2 (Zpos mx) ex (Rabs x) lx ->
(x <> 0)%R ->
inbetween_float radix2 mx ex (Rabs x) lx ->
(ex <= cexp radix2 fexp x)%Z ->
let z := binary_round_aux mode (Rlt_bool x 0) mx ex lx in
valid_binary z = true /\
......@@ -929,14 +930,14 @@ Theorem binary_round_aux_correct' :
else
z = binary_overflow mode (Rlt_bool x 0).
Proof with auto with typeclass_instances.
intros m x mx ex lx Bx Ex z.
intros m x mx ex lx Px Bx Ex z.
unfold binary_round_aux in z.
revert z.
rewrite shr_truncate. 2: easy.
refine (_ (round_trunc_sign_any_correct' _ _ (round_mode m) (choice_mode m) _ x (Zpos mx) ex lx Bx (or_introl _ Ex))).
rewrite shr_truncate.
refine (_ (round_trunc_sign_any_correct' _ _ (round_mode m) (choice_mode m) _ x mx ex lx Bx (or_introl _ Ex))).
rewrite <- cexp_abs in Ex.
refine (_ (truncate_correct_partial' _ fexp _ _ _ _ _ Bx Ex)).
destruct (truncate radix2 fexp (Zpos mx, ex, lx)) as ((m1, e1), l1).
destruct (truncate radix2 fexp (mx, ex, lx)) as ((m1, e1), l1).
rewrite loc_of_shr_record_of_loc, shr_m_shr_record_of_loc.
set (m1' := choice_mode m (Rlt_bool x 0) m1 l1).
intros (H1a,H1b) H1c.
......@@ -1082,8 +1083,7 @@ apply Rlt_le_trans with R0.
now apply F2R_lt_0.
apply Rabs_pos.
(* *)
apply Rlt_le_trans with (2 := proj1 (inbetween_float_bounds _ _ _ _ _ Bx)).
now apply F2R_gt_0.
now apply Rabs_pos_lt.
(* all the modes are valid *)
clear. case m.
exact inbetween_int_NE_sign.
......@@ -1091,13 +1091,19 @@ exact inbetween_int_ZR_sign.
exact inbetween_int_DN_sign.
exact inbetween_int_UP_sign.
exact inbetween_int_NA_sign.
(* *)
apply inbetween_float_bounds in Bx.
apply Zlt_succ_le.
eapply F2R_gt_0_reg.
apply Rle_lt_trans with (2 := proj2 Bx).
apply Rabs_pos.
Qed.
Theorem binary_round_aux_correct :
forall mode x mx ex lx,
inbetween_float radix2 (Zpos mx) ex (Rabs x) lx ->
(ex <= fexp (Zdigits radix2 (Zpos mx) + ex))%Z ->
let z := binary_round_aux mode (Rlt_bool x 0) mx ex lx in
let z := binary_round_aux mode (Rlt_bool x 0) (Zpos mx) ex lx in
valid_binary z = true /\
if Rlt_bool (Rabs (round radix2 fexp (round_mode mode) x)) (bpow radix2 emax) then
FF2R radix2 z = round radix2 fexp (round_mode mode) x /\
......@@ -1274,7 +1280,7 @@ Lemma Bmult_correct_aux :
forall m sx mx ex (Hx : bounded mx ex = true) sy my ey (Hy : bounded my ey = true),
let x := F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) in
let y := F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey) in
let z := binary_round_aux m (xorb sx sy) (mx * my) (ex + ey) loc_Exact in
let z := binary_round_aux m (xorb sx sy) (Zpos (mx * my)) (ex + ey) loc_Exact in
valid_binary z = true /\
if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (x * y))) (bpow radix2 emax) then
FF2R radix2 z = round radix2 fexp (round_mode m) (x * y) /\
......@@ -1447,7 +1453,7 @@ now rewrite mag_F2R_Zdigits.
Qed.
Definition binary_round m sx mx ex :=
let '(mz, ez) := shl_align_fexp mx ex in binary_round_aux m sx mz ez loc_Exact.
let '(mz, ez) := shl_align_fexp mx ex in binary_round_aux m sx (Zpos mz) ez loc_Exact.
Theorem binary_round_correct :
forall m sx mx ex,
......@@ -1784,13 +1790,15 @@ Qed.
Definition Fdiv_core_binary m1 e1 m2 e2 :=
let d1 := Zdigits2 m1 in
let d2 := Zdigits2 m2 in
let e := (e1 - e2)%Z in
let (m, e') :=
match (d2 + prec - d1)%Z with
| Zpos p => (Z.shiftl m1 (Zpos p), e + Zneg p)%Z
| _ => (m1, e)
let e' := Zmin (fexp (d1 + e1 - (d2 + e2))) (e1 - e2) in
let s := (e1 - e2 - e')%Z in
let m' :=
match s with
| Zpos _ => Z.shiftl m1 s
| Z0 => m1
| Zneg _ => Z0
end in
let '(q, r) := Zfast_div_eucl m m2 in
let '(q, r) := Zfast_div_eucl m' m2 in
(q, e', new_location m2 r loc_Exact).
Lemma Bdiv_correct_aux :
......@@ -1799,10 +1807,7 @@ Lemma Bdiv_correct_aux :
let y := F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey) in
let z :=
let '(mz, ez, lz) := Fdiv_core_binary (Zpos mx) ex (Zpos my) ey in
match mz with
| Zpos mz => binary_round_aux m (xorb sx sy) mz ez lz
| _ => F754_nan false xH (* dummy *)
end in
binary_round_aux m (xorb sx sy) mz ez lz in
valid_binary z = true /\
if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (x / y))) (bpow radix2 emax) then
FF2R radix2 z = round radix2 fexp (round_mode m) (x / y) /\
......@@ -1811,44 +1816,26 @@ Lemma Bdiv_correct_aux :
z = binary_overflow m (xorb sx sy).
Proof.
intros m sx mx ex sy my ey.
replace (Fdiv_core_binary (Zpos mx) ex (Zpos my) ey) with (Fdiv_core radix2 prec (Zpos mx) ex (Zpos my) ey).
refine (_ (Fdiv_core_correct radix2 prec (Zpos mx) ex (Zpos my) ey _ _ _)) ; try easy.
destruct (Fdiv_core radix2 prec (Zpos mx) ex (Zpos my) ey) as ((mz, ez), lz).
assert (Fdiv_core_binary (Zpos mx) ex (Zpos my) ey = Fdiv_core radix2 fexp (Zpos mx) ex (Zpos my) ey) as ->.
{ unfold Fdiv_core, Fdiv_core_binary.
rewrite 2!Zdigits2_Zdigits.
rewrite (Z.min_l _ (fexp _)).
change 2%Z with (radix_val radix2).
set (e' := Zmin _ _).
destruct (ex - ey - e')%Z as [|p|p].
rewrite Zmult_1_r.
now rewrite Zfast_div_eucl_correct.
rewrite Z.shiftl_mul_pow2 by easy.
now rewrite Zfast_div_eucl_correct.
now rewrite Zfast_div_eucl_correct.
apply FLT_exp_monotone, Z.le_succ_diag_r. }
refine (_ (Fdiv_core_correct radix2 fexp (Zpos mx) ex (Zpos my) ey _ _)) ; try easy.
destruct (Fdiv_core radix2 fexp (Zpos mx) ex (Zpos my) ey) as ((mz, ez), lz).
intros (Pz, Bz).
simpl.
replace (xorb sx sy) with (Rlt_bool (F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) *
/ F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey)) 0).
unfold Rdiv.
destruct mz as [|mz|mz].
(* . mz = 0 *)
elim (Zlt_irrefl prec).
now apply Zle_lt_trans with Z0.
(* . mz > 0 *)
apply binary_round_aux_correct.
rewrite Rabs_mult, Rabs_Rinv.
now rewrite <- 2!F2R_Zabs, 2!abs_cond_Zopp.
case sy.
apply Rlt_not_eq.
now apply F2R_lt_0.
apply Rgt_not_eq.
now apply F2R_gt_0.
revert Pz.
generalize (Zdigits radix2 (Zpos mz)).
unfold fexp, FLT_exp.
clear.
intros ; zify ; subst.
omega.
(* . mz < 0 *)
elim Rlt_not_le with (1 := proj2 (inbetween_float_bounds _ _ _ _ _ Bz)).
apply Rle_trans with R0.
apply F2R_le_0.
now case mz.
apply Rmult_le_pos.
now apply F2R_ge_0.
apply Rlt_le.
apply Rinv_0_lt_compat.
now apply F2R_gt_0.
(* *)
assert (xorb sx sy = Rlt_bool (F2R (Float radix2 (cond_Zopp sx (Zpos mx)) ex) *
/ F2R (Float radix2 (cond_Zopp sy (Zpos my)) ey)) 0) as ->.
{ apply eq_sym.
case sy ; simpl.
change (Zneg my) with (Zopp (Zpos my)).
rewrite F2R_Zopp.
......@@ -1887,16 +1874,21 @@ apply Rmult_le_pos.
now apply F2R_ge_0.
apply Rlt_le.
apply Rinv_0_lt_compat.
now apply F2R_gt_0.
(* *)
unfold Fdiv_core_binary, Fdiv_core.
rewrite 2!Zdigits2_Zdigits.
change 2%Z with (radix_val radix2).
destruct (Zdigits radix2 (Z.pos my) + prec - Zdigits radix2 (Z.pos mx))%Z as [|p|p].
now rewrite Zfast_div_eucl_correct.
rewrite Z.shiftl_mul_pow2 by easy.
now rewrite Zfast_div_eucl_correct.
now rewrite Zfast_div_eucl_correct.
now apply F2R_gt_0. }
unfold Rdiv.
apply binary_round_aux_correct'.
- apply Rmult_integral_contrapositive_currified.
now apply F2R_neq_0 ; case sx.
apply Rinv_neq_0_compat.
now apply F2R_neq_0 ; case sy.
- rewrite Rabs_mult, Rabs_Rinv.
now rewrite <- 2!F2R_Zabs, 2!abs_cond_Zopp.
now apply F2R_neq_0 ; case sy.
- rewrite <- cexp_abs, Rabs_mult, Rabs_Rinv.
rewrite 2!F2R_cond_Zopp, 2!abs_cond_Ropp, <- Rabs_Rinv.
now rewrite <- Rabs_mult, cexp_abs.
now apply F2R_neq_0.
now apply F2R_neq_0 ; case sy.
Qed.
Definition Bdiv div_nan m x y :=
......@@ -1968,61 +1960,30 @@ Lemma Bsqrt_correct_aux :
let x := F2R (Float radix2 (Zpos mx) ex) in
let z :=
let '(mz, ez, lz) := Fsqrt_core_binary (Zpos mx) ex in
match mz with
| Zpos mz => binary_round_aux m false mz ez lz
| _ => F754_nan false xH (* dummy *)
end in
binary_round_aux m false mz ez lz in
valid_binary z = true /\
FF2R radix2 z = round radix2 fexp (round_mode m) (sqrt x) /\
is_finite_FF z = true /\ sign_FF z = false.
Proof with auto with typeclass_instances.
intros m mx ex Hx.
assert (Fsqrt_core_binary (Zpos mx) ex = Fsqrt_core radix2 fexp (Zpos mx) ex) as ->.
unfold Fsqrt_core, Fsqrt_core_binary.
{ unfold Fsqrt_core, Fsqrt_core_binary.
rewrite Zdigits2_Zdigits.
set (e' := Zmin (fexp (Z.div2 (Zdigits radix2 (Zpos mx) + ex + 1))) (Z.div2 ex)).
destruct (ex - 2 * e')%Z as [|s|s].
now rewrite Zmult_1_r.
now rewrite Z.shiftl_mul_pow2.
easy.
easy. }
simpl.
refine (_ (Fsqrt_core_correct radix2 fexp (Zpos mx) ex _)) ; try easy.
destruct (Fsqrt_core radix2 fexp (Zpos mx) ex) as ((mz, ez), lz).
intros (Pz, Bz).
destruct mz as [|mz|mz].
- apply inbetween_float_bounds in Bz.
elim (Zlt_irrefl ez).
apply Zle_lt_trans with (1 := Pz).
apply lt_bpow with radix2.
rewrite <- (F2R_bpow radix2 ez).
apply Rle_lt_trans with (2 := proj2 Bz).
clear -Hx prec_gt_0_ Hmax.
apply bounded_ge_emin in Hx.
unfold cexp.
destruct mag as [e He].
simpl.
refine (_ (He _)).
2: now apply Rgt_not_eq, sqrt_lt_R0, F2R_gt_0.
clear He.
rewrite Rabs_pos_eq by apply sqrt_ge_0.
intros He.
apply Rle_trans with (2 := proj1 He).
apply bpow_le.
apply sqrt_le_1_alt in Hx.
apply (fun H => Rle_lt_trans _ _ _ H (proj2 He)) in Hx.
rewrite <- (sqrt_Rsqr (bpow radix2 e)) in Hx by apply bpow_ge_0.
apply sqrt_lt_0_alt in Hx.
unfold Rsqr in Hx.
rewrite <- bpow_plus in Hx.
apply lt_bpow in Hx.
unfold fexp, FLT_exp.
unfold Prec_gt_0 in prec_gt_0_.
revert Hx.
unfold emin.
intros ; zify ; omega.
- refine (_ (binary_round_aux_correct' m (sqrt (F2R (Float radix2 (Zpos mx) ex))) mz ez lz _ _)).
rewrite Rlt_bool_false.
2: apply sqrt_ge_0.
refine (_ (binary_round_aux_correct' m (sqrt (F2R (Float radix2 (Zpos mx) ex))) mz ez lz _ _ Pz)) ; cycle 1.
now apply Rgt_not_eq, sqrt_lt_R0, F2R_gt_0.
rewrite Rabs_pos_eq.
exact Bz.
apply sqrt_ge_0.
rewrite Rlt_bool_false by apply sqrt_ge_0.
rewrite Rlt_bool_true.
easy.
rewrite Rabs_pos_eq.
......@@ -2086,24 +2047,9 @@ now apply F2R_gt_0.
apply generic_format_canonical.
apply (canonical_canonical_mantissa false).
apply (andb_prop _ _ Hx).
(* .. *)
apply round_ge_generic...
apply generic_format_0.
apply sqrt_ge_0.
rewrite Rabs_pos_eq.
exact Bz.
apply sqrt_ge_0.
revert Pz.
generalize (Zdigits radix2 (Zpos mz)).
unfold fexp, FLT_exp.
clear.
intros ; zify ; subst.
omega.
- elim Rlt_not_le with (1 := proj2 (inbetween_float_bounds _ _ _ _ _ Bz)).
apply Rle_trans with R0.
apply F2R_le_0.
now case mz.
apply sqrt_ge_0.
Qed.
Definition Bsqrt sqrt_nan m x :=
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment