Commit 80196ef0 authored by Guillaume Melquiond's avatar Guillaume Melquiond

Use float arguments for Fdiv and Fsqrt.

parent 7d4b2df1
......@@ -80,9 +80,8 @@ apply sym_eq, F2R_Zabs.
Qed.
Definition sqrt (x : float beta) :=
let (m, e) := x in
if Zlt_bool 0 m then
let '(m', e', l) := truncate beta fexp (Fsqrt beta fexp m e) in
if Zlt_bool 0 (Fnum x) then
let '(m', e', l) := truncate beta fexp (Fsqrt beta fexp x) in
Float beta (choice false m' l) e'
else Float beta 0 0.
......@@ -90,10 +89,10 @@ Theorem sqrt_correct :
forall x : float beta,
round beta fexp rnd (R_sqrt.sqrt (F2R x)) = F2R (sqrt x).
Proof.
intros [m e].
intros x.
unfold sqrt.
case Zlt_bool_spec ; intros Hm.
generalize (Fsqrt_correct beta fexp m e Hm).
generalize (Fsqrt_correct beta fexp x (F2R_gt_0 _ _ Hm)).
destruct Fsqrt as [[m' e'] l].
intros [Hs1 Hs2].
rewrite (round_trunc_sign_any_correct' beta fexp rnd choice rnd_choice _ m' e' l).
......@@ -101,7 +100,7 @@ destruct truncate as [[m'' e''] l'].
now rewrite Rlt_bool_false by apply sqrt_ge_0.
now rewrite Rabs_pos_eq by apply sqrt_ge_0.
now left.
destruct (Req_dec (F2R (Float beta m e)) 0) as [Hz|Hz].
destruct (Req_dec (F2R x) 0) as [Hz|Hz].
rewrite Hz, sqrt_0, F2R_0.
now apply round_0.
unfold R_sqrt.sqrt.
......@@ -159,12 +158,10 @@ now elim Hy0.
Qed.
Definition div (x y : float beta) :=
let (mx, ex) := x in
let (my, ey) := y in
if Zeq_bool mx 0 then Float beta 0 0
if Zeq_bool (Fnum x) 0 then Float beta 0 0
else
let '(m, e, l) := truncate beta fexp (Fdiv beta fexp (Zabs mx) ex (Zabs my) ey) in
let s := xorb (Zlt_bool mx 0) (Zlt_bool my 0) in
let '(m, e, l) := truncate beta fexp (Fdiv beta fexp (Fabs _ x) (Fabs _ y)) in
let s := xorb (Zlt_bool (Fnum x) 0) (Zlt_bool (Fnum y) 0) in
Float beta (cond_Zopp s (choice s m l)) e.
Theorem div_correct :
......@@ -172,41 +169,43 @@ Theorem div_correct :
F2R y <> 0%R ->
round beta fexp rnd (F2R x / F2R y) = F2R (div x y).
Proof.
intros [mx ex] [my ey] Hy.
intros x y Hy.
unfold div.
case Zeq_bool_spec ; intros Hm.
rewrite Hm, 2!F2R_0.
unfold Rdiv.
rewrite Rmult_0_l.
now apply round_0.
assert (Hx: (0 < Zabs mx)%Z) by now apply Z.abs_pos.
assert (Hy': (0 < Zabs my)%Z).
apply Z.abs_pos.
destruct x as [mx ex].
simpl in Hm.
rewrite Hm, 2!F2R_0.
unfold Rdiv.
rewrite Rmult_0_l.
now apply round_0.
assert (0 < F2R (Fabs _ x))%R as Hx.
destruct x as [mx ex].
now apply F2R_gt_0, Z.abs_pos.
assert (0 < F2R (Fabs _ y))%R as Hy'.
destruct y as [my ey].
apply F2R_gt_0, Z.abs_pos.
contradict Hy.
rewrite Hy.
apply F2R_0.
generalize (Fdiv_correct beta fexp (Zabs mx) ex (Zabs my) ey Hx Hy').
generalize (Fdiv_correct beta fexp (Fabs _ x) (Fabs _ y) Hx Hy').
destruct Fdiv as [[m e] l].
intros [Hs1 Hs2].
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.
apply f_equal2 ; apply Rsgn_F2R.
contradict Hm.
apply eq_0_F2R with (1 := Hm).
exact Hy.
unfold Rdiv.
rewrite Rabs_mult, Rabs_Rinv.
rewrite <- 2!F2R_Zabs.
exact Hs2.
exact Hy.
left.
rewrite <- cexp_abs.
unfold Rdiv.
rewrite Rabs_mult, Rabs_Rinv.
now rewrite <- 2!F2R_Zabs.
exact Hy.
- destruct truncate as [[m' e'] l'].
apply (f_equal (fun s => F2R (Float beta (cond_Zopp s (choice s _ _)) _))).
rewrite Rsgn_div.
apply f_equal2 ; apply Rsgn_F2R.
contradict Hm.
apply eq_0_F2R with (1 := Hm).
exact Hy.
- unfold Rdiv.
rewrite Rabs_mult, Rabs_Rinv by exact Hy.
now rewrite <- 2!F2R_abs.
- left.
rewrite <- cexp_abs.
unfold Rdiv.
rewrite Rabs_mult, Rabs_Rinv by exact Hy.
now rewrite <- 2!F2R_abs.
Qed.
End Compute.
......@@ -116,20 +116,24 @@ destruct (Z_lt_le_dec 1 m2') as [Hm2''|Hm2''].
now constructor.
Qed.
Definition Fdiv m1 e1 m2 e2 :=
Definition Fdiv (x y : float beta) :=
let (m1, e1) := x in
let (m2, e2) := y in
let e' := ((Zdigits beta m1 + e1) - (Zdigits beta m2 + e2))%Z in
let e := Zmin (Zmin (fexp e') (fexp (e' + 1))) (e1 - e2) in
let '(m, l) := Fdiv_core m1 e1 m2 e2 e in
(m, e, l).
Theorem Fdiv_correct :
forall m1 e1 m2 e2,
(0 < m1)%Z -> (0 < m2)%Z ->
let '(m, e, l) := Fdiv 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.
forall x y,
(0 < F2R x)%R -> (0 < F2R y)%R ->
let '(m, e, l) := Fdiv x y in
(e <= cexp beta fexp (F2R x / F2R y))%Z /\
inbetween_float beta m e (F2R x / F2R y) l.
Proof.
intros m1 e1 m2 e2 Hm1 Hm2.
intros [m1 e1] [m2 e2] Hm1 Hm2.
apply gt_0_F2R in Hm1.
apply gt_0_F2R in Hm2.
unfold Fdiv.
generalize (mag_div_F2R m1 e1 m2 e2 Hm1 Hm2).
set (e := Zminus _ _).
......
......@@ -164,20 +164,22 @@ now apply IZR_le.
apply sqrt_ge_0.
Qed.
Definition Fsqrt m1 e1 :=
Definition Fsqrt (x : float beta) :=
let (m1, e1) := x in
let e' := (Zdigits beta m1 + e1 + 1)%Z in
let e := Zmin (fexp (Z.div2 e')) (Z.div2 e1) in
let (m, l) := Fsqrt_core m1 e1 e in
let '(m, l) := Fsqrt_core m1 e1 e in
(m, e, l).
Theorem Fsqrt_correct :
forall m1 e1,
(0 < m1)%Z ->
let '(m, e, l) := Fsqrt m1 e1 in
(e <= cexp beta fexp (sqrt (F2R (Float beta m1 e1))))%Z /\
inbetween_float beta m e (sqrt (F2R (Float beta m1 e1))) l.
forall x,
(0 < F2R x)%R ->
let '(m, e, l) := Fsqrt x in
(e <= cexp beta fexp (sqrt (F2R x)))%Z /\
inbetween_float beta m e (sqrt (F2R x)) l.
Proof.
intros m1 e1 Hm1.
intros [m1 e1] Hm1.
apply gt_0_F2R in Hm1.
unfold Fsqrt.
set (e := Zmin _ _).
assert (2 * e <= e1)%Z as He.
......
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