Mise à jour terminée. Pour connaître les apports de la version 13.8.4 par rapport à notre ancienne version vous pouvez lire les "Release Notes" suivantes :
https://about.gitlab.com/releases/2021/02/11/security-release-gitlab-13-8-4-released/
https://about.gitlab.com/releases/2021/02/05/gitlab-13-8-3-released/

Commit 01858c76 authored by Guillaume Melquiond's avatar Guillaume Melquiond

Added a typeclass for rounding functions.

parent de2f0164
......@@ -63,8 +63,8 @@ Qed.
Definition MinOrMax x f :=
((f = round beta (FLX_exp prec) rndDN x)
\/ (f = round beta (FLX_exp prec) rndUP x)).
((f = round beta (FLX_exp prec) Zfloor x)
\/ (f = round beta (FLX_exp prec) Zceil x)).
Theorem MinOrMax_opp: forall x f,
MinOrMax x f <-> MinOrMax (-x) (-f).
......@@ -85,7 +85,7 @@ Theorem implies_DN_lt_ulp:
forall x f, format f ->
(0 < f <= x)%R ->
(Rabs (f-x) < ulp f)%R ->
(f = round beta (FLX_exp prec) rndDN x)%R.
(f = round beta (FLX_exp prec) Zfloor x)%R.
intros x f Hf Hxf1 Hxf2.
apply sym_eq.
replace x with (f+-(f-x))%R by ring.
......@@ -160,8 +160,8 @@ Hypothesis Ha: format a.
Hypothesis Hx: format x.
Hypothesis Hy: format y.
Notation t := (round beta (FLX_exp prec) (rndN choice) (a*x)).
Notation u := (round beta (FLX_exp prec) (rndN choice) (t+y)).
Notation t := (round beta (FLX_exp prec) (Znearest choice) (a*x)).
Notation u := (round beta (FLX_exp prec) (Znearest choice) (t+y)).
(*
Axpy_aux1 : lemma Closest?(b)(a*x,t) => Closest?(b)(t+y,u) => 0 < u
......
......@@ -52,6 +52,7 @@ Hypothesis Hmax : (prec < emax)%Z.
Let emin := (3 - emax - prec)%Z.
Let fexp := FLT_exp emin prec.
Instance fexp_correct : Valid_exp fexp := FLT_exp_valid emin prec.
Instance fexp_monotone : Monotone_exp fexp := FLT_exp_monotone emin prec.
Definition bounded_prec m e :=
Zeq_bool (fexp (Z_of_nat (S (digits2_Pnat m)) + e)) e.
......@@ -526,11 +527,11 @@ Inductive mode := mode_NE | mode_ZR | mode_DN | mode_UP | mode_NA.
Definition round_mode m :=
match m with
| mode_NE => rndNE
| mode_ZR => rndZR
| mode_DN => rndDN
| mode_UP => rndUP
| mode_NA => rndNA
| mode_NE => ZnearestE
| mode_ZR => Ztrunc
| mode_DN => Zfloor
| mode_UP => Zceil
| mode_NA => ZnearestA
end.
Definition choice_mode m sx mx lx :=
......@@ -542,6 +543,11 @@ Definition choice_mode m sx mx lx :=
| mode_NA => cond_incr (round_N true lx) mx
end.
Global Instance valid_rnd_round_mode : forall m, Valid_rnd (round_mode m).
Proof.
destruct m ; unfold round_mode ; auto with typeclass_instances.
Qed.
Definition overflow_to_inf m s :=
match m with
| mode_NE => true
......@@ -573,7 +579,7 @@ Theorem binary_round_sign_correct :
FF2R radix2 (binary_round_sign mode (Rlt_bool x 0) mx ex lx) = round radix2 fexp (round_mode mode) x
else
binary_round_sign mode (Rlt_bool x 0) mx ex lx = binary_overflow mode (Rlt_bool x 0).
Proof.
Proof with auto with typeclass_instances.
intros m x mx ex lx Bx Ex.
unfold binary_round_sign.
rewrite shr_truncate. 2: easy.
......@@ -627,9 +633,7 @@ rewrite <- ln_beta_F2R_digits, <- Hr, ln_beta_abs.
rewrite H1b.
rewrite canonic_exponent_abs.
fold (canonic_exponent radix2 fexp (round radix2 fexp (round_mode m) x)).
apply canonic_exponent_round.
apply fexp_correct.
apply FLT_exp_monotone.
apply canonic_exponent_round...
rewrite H1c.
case (Rlt_bool x 0).
apply Rlt_not_eq.
......@@ -718,9 +722,8 @@ apply Rlt_trans with R0.
now apply F2R_lt_0_compat.
now apply F2R_gt_0_compat.
rewrite <- Hr.
apply generic_format_abs.
apply generic_format_round.
apply fexp_correct.
apply generic_format_abs...
apply generic_format_round...
(* . not m1' < 0 *)
elim Rgt_not_eq with (2 := Hr).
apply Rlt_le_trans with R0.
......@@ -822,7 +825,7 @@ Theorem Bmult_correct :
B2FF (Bmult m x y) = binary_overflow m (xorb (Bsign x) (Bsign y)).
Proof.
intros m [sx|sx| |sx mx ex Hx] [sy|sy| |sy my ey Hy] ;
try ( rewrite ?Rmult_0_r, ?Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ apply refl_equal | apply bpow_gt_0 ] ).
try ( rewrite ?Rmult_0_r, ?Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ apply refl_equal | apply bpow_gt_0 | auto with typeclass_instances ] ).
simpl.
case Bmult_correct_aux.
intros H1 H2.
......@@ -978,22 +981,20 @@ Theorem Bplus_correct :
B2R (Bplus m x y) = round radix2 fexp (round_mode m) (B2R x + B2R y)
else
(B2FF (Bplus m x y) = binary_overflow m (Bsign x) /\ Bsign x = Bsign y).
Proof.
Proof with auto with typeclass_instances.
intros 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.
case (Bool.eqb sx sy) ; try easy.
now case m.
apply bpow_gt_0.
(* *)
rewrite Rplus_0_l, round_generic, Rlt_bool_true.
apply refl_equal.
rewrite Rplus_0_l, round_generic, Rlt_bool_true...
apply B2R_lt_emax.
apply generic_format_B2R.
(* *)
rewrite Rplus_0_r, round_generic, Rlt_bool_true.
apply refl_equal.
rewrite Rplus_0_r, round_generic, Rlt_bool_true...
apply B2R_lt_emax.
apply generic_format_B2R.
(* *)
......@@ -1058,15 +1059,13 @@ split.
apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)).
rewrite <- opp_F2R.
now apply Ropp_lt_contravar.
apply round_monotone_l.
apply fexp_correct.
apply round_monotone_l...
now apply generic_format_canonic.
pattern (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)) at 1 ; rewrite <- Rplus_0_r.
apply Rplus_le_compat_l.
now apply F2R_ge_0_compat.
apply Rle_lt_trans with (2 := By).
apply round_monotone_r.
apply fexp_correct.
apply round_monotone_r...
now apply generic_format_canonic.
rewrite <- (Rplus_0_l (F2R (Float radix2 (Zpos my) ey))).
apply Rplus_le_compat_r.
......@@ -1080,22 +1079,20 @@ split.
apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)).
rewrite <- opp_F2R.
now apply Ropp_lt_contravar.
apply round_monotone_l.
apply fexp_correct.
apply round_monotone_l...
now apply generic_format_canonic.
pattern (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)) at 1 ; rewrite <- Rplus_0_l.
apply Rplus_le_compat_r.
now apply F2R_ge_0_compat.
apply Rle_lt_trans with (2 := Bx).
apply round_monotone_r.
apply fexp_correct.
apply round_monotone_r...
now apply generic_format_canonic.
rewrite <- (Rplus_0_r (F2R (Float radix2 (Zpos mx) ex))).
apply Rplus_le_compat_l.
now apply F2R_le_0_compat.
destruct mz as [|mz|mz].
(* . mz = 0 *)
rewrite F2R_0, round_0, Rabs_R0, Rlt_bool_true.
rewrite F2R_0, round_0, Rabs_R0, Rlt_bool_true...
now case m.
apply bpow_gt_0.
(* . mz > 0 *)
......@@ -1253,7 +1250,7 @@ intros m x [sy|sy| |sy my ey Hy] Zy ; try now elim Zy.
revert x.
unfold Rdiv.
intros [sx|sx| |sx mx ex Hx] ;
try ( rewrite Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ apply refl_equal | apply bpow_gt_0 ] ).
try ( rewrite Rmult_0_l, round_0, Rabs_R0, Rlt_bool_true ; [ apply refl_equal | apply bpow_gt_0 | auto with typeclass_instances ] ).
simpl.
case Bdiv_correct_aux.
intros H1 H2.
......@@ -1275,7 +1272,7 @@ Lemma Bsqrt_correct_aux :
end in
valid_binary z = true /\
FF2R radix2 z = round radix2 fexp (round_mode m) (sqrt x).
Proof.
Proof with auto with typeclass_instances.
intros m mx ex Hx.
simpl.
refine (_ (Fsqrt_core_correct radix2 prec (Zpos mx) ex _)) ; try easy.
......@@ -1353,8 +1350,7 @@ apply generic_format_canonic.
apply (canonic_bounded_prec false).
apply (andb_prop _ _ Hx).
(* .. *)
apply round_monotone_l.
apply fexp_correct.
apply round_monotone_l...
apply generic_format_0.
apply sqrt_ge_0.
rewrite Rabs_pos_eq.
......@@ -1389,7 +1385,7 @@ Theorem Bsqrt_correct :
forall m x,
B2R (Bsqrt m x) = round radix2 fexp (round_mode m) (sqrt (B2R x)).
Proof.
intros m [sx|[|]| |sx mx ex Hx] ; try ( now simpl ; rewrite sqrt_0, round_0 ).
intros m [sx|[|]| |sx mx ex Hx] ; try ( now simpl ; rewrite sqrt_0, round_0 ; auto with typeclass_instances ).
simpl.
case Bsqrt_correct_aux.
intros H1 H2.
......@@ -1399,6 +1395,7 @@ unfold sqrt.
case Rcase_abs.
intros _.
apply round_0.
auto with typeclass_instances.
intros H.
elim Rge_not_lt with (1 := H).
now apply F2R_lt_0_compat.
......
......@@ -44,7 +44,7 @@ Theorem Fsqrt_FLT_ne_correct :
Rnd_NE_pt beta (FLT_exp emin prec) (sqrt (F2R x)) (F2R (Fsqrt_FLT_ne x)).
Proof with auto with typeclass_instances.
intros x.
replace (F2R (Fsqrt_FLT_ne x)) with (round beta (FLT_exp emin prec) rndNE (sqrt (F2R x))).
replace (F2R (Fsqrt_FLT_ne x)) with (round beta (FLT_exp emin prec) ZnearestE (sqrt (F2R x))).
apply round_NE_pt...
unfold Fsqrt_FLT_ne.
destruct x as (mx, ex).
......@@ -53,7 +53,7 @@ case (Zle_bool mx 0) ; intros Hm.
(* mx = 0 *)
rewrite F2R_0.
replace (sqrt (F2R (Float beta mx ex))) with R0.
apply round_0.
apply round_0...
destruct (Zle_lt_or_eq _ _ Hm) as [Hm'|Hm'].
unfold sqrt.
case Rcase_abs ; intros Hs.
......
......@@ -38,7 +38,7 @@ Notation format := (generic_format beta fexp).
Theorem inbetween_float_round :
forall rnd choice,
( forall x m l, inbetween_int m x l -> Zrnd rnd x = choice m l ) ->
( forall x m l, inbetween_int m x l -> rnd x = choice m l ) ->
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l ->
......@@ -58,7 +58,7 @@ Definition cond_incr (b : bool) m := if b then (m + 1)%Z else m.
Theorem inbetween_float_round_sign :
forall rnd choice,
( forall x m l, inbetween_int m (Rabs x) l ->
Zrnd rnd x = cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m l) ) ->
rnd x = cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m l) ) ->
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e (Rabs x) l ->
......@@ -93,7 +93,7 @@ Qed.
Theorem inbetween_int_DN :
forall x m l,
inbetween_int m x l ->
Zrnd rndDN x = m.
Zfloor x = m.
Proof.
intros x m l Hl.
refine (Zfloor_imp m _ _).
......@@ -106,7 +106,7 @@ Theorem inbetween_float_DN :
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l ->
round beta fexp rndDN x = F2R (Float beta m e).
round beta fexp Zfloor x = F2R (Float beta m e).
Proof.
apply inbetween_float_round with (choice := fun m l => m).
exact inbetween_int_DN.
......@@ -121,7 +121,7 @@ Definition round_sign_DN s l :=
Theorem inbetween_int_DN_sign :
forall x m l,
inbetween_int m (Rabs x) l ->
Zrnd rndDN x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_DN (Rlt_bool x 0) l) m).
Zfloor x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_DN (Rlt_bool x 0) l) m).
Proof.
intros x m l Hl.
unfold Rabs in Hl.
......@@ -158,7 +158,7 @@ Theorem inbetween_float_DN_sign :
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e (Rabs x) l ->
round beta fexp rndDN x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_DN (Rlt_bool x 0) l) m)) e).
round beta fexp Zfloor x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_DN (Rlt_bool x 0) l) m)) e).
Proof.
apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_sign_DN s l) m).
exact inbetween_int_DN_sign.
......@@ -175,7 +175,7 @@ Definition round_UP l :=
Theorem inbetween_int_UP :
forall x m l,
inbetween_int m x l ->
Zrnd rndUP x = cond_incr (round_UP l) m.
Zceil x = cond_incr (round_UP l) m.
Proof.
intros x m l Hl.
assert (Hl': l = loc_Exact \/ (l <> loc_Exact /\ round_UP l = true)).
......@@ -199,7 +199,7 @@ Theorem inbetween_float_UP :
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l ->
round beta fexp rndUP x = F2R (Float beta (cond_incr (round_UP l) m) e).
round beta fexp Zceil x = F2R (Float beta (cond_incr (round_UP l) m) e).
Proof.
apply inbetween_float_round with (choice := fun m l => cond_incr (round_UP l) m).
exact inbetween_int_UP.
......@@ -214,7 +214,7 @@ Definition round_sign_UP s l :=
Theorem inbetween_int_UP_sign :
forall x m l,
inbetween_int m (Rabs x) l ->
Zrnd rndUP x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_UP (Rlt_bool x 0) l) m).
Zceil x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_UP (Rlt_bool x 0) l) m).
Proof.
intros x m l Hl.
unfold Rabs in Hl.
......@@ -249,7 +249,7 @@ Theorem inbetween_float_UP_sign :
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e (Rabs x) l ->
round beta fexp rndUP x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_UP (Rlt_bool x 0) l) m)) e).
round beta fexp Zceil x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_sign_UP (Rlt_bool x 0) l) m)) e).
Proof.
apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_sign_UP s l) m).
exact inbetween_int_UP_sign.
......@@ -266,15 +266,15 @@ Definition round_ZR (s : bool) l :=
Theorem inbetween_int_ZR :
forall x m l,
inbetween_int m x l ->
Zrnd rndZR x = cond_incr (round_ZR (Zlt_bool m 0) l) m.
Proof.
Ztrunc x = cond_incr (round_ZR (Zlt_bool m 0) l) m.
Proof with auto with typeclass_instances.
intros x m l Hl.
inversion_clear Hl as [Hx|l' Hx Hl'].
(* Exact *)
rewrite Hx.
now rewrite Zrnd_Z2R.
rewrite Zrnd_Z2R...
(* not Exact *)
unfold Zrnd, rndZR, Ztrunc.
unfold Ztrunc.
assert (Hm: Zfloor x = m).
apply Zfloor_imp.
exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)).
......@@ -300,7 +300,7 @@ Theorem inbetween_float_ZR :
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l ->
round beta fexp rndZR x = F2R (Float beta (cond_incr (round_ZR (Zlt_bool m 0) l) m) e).
round beta fexp Ztrunc x = F2R (Float beta (cond_incr (round_ZR (Zlt_bool m 0) l) m) e).
Proof.
apply inbetween_float_round with (choice := fun m l => cond_incr (round_ZR (Zlt_bool m 0) l) m).
exact inbetween_int_ZR.
......@@ -309,7 +309,7 @@ Qed.
Theorem inbetween_int_ZR_sign :
forall x m l,
inbetween_int m (Rabs x) l ->
Zrnd rndZR x = cond_Zopp (Rlt_bool x 0) m.
Ztrunc x = cond_Zopp (Rlt_bool x 0) m.
Proof.
intros x m l Hl.
simpl.
......@@ -339,7 +339,7 @@ Theorem inbetween_float_ZR_sign :
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e (Rabs x) l ->
round beta fexp rndZR x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) m) e).
round beta fexp Ztrunc x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) m) e).
Proof.
apply inbetween_float_round_sign with (choice := fun s m l => m).
exact inbetween_int_ZR_sign.
......@@ -358,15 +358,15 @@ Definition round_N (p : bool) l :=
Theorem inbetween_int_N :
forall choice x m l,
inbetween_int m x l ->
Zrnd (rndN choice) x = cond_incr (round_N (choice m) l) m.
Proof.
Znearest choice x = cond_incr (round_N (choice m) l) m.
Proof with auto with typeclass_instances.
intros choice x m l Hl.
inversion_clear Hl as [Hx|l' Hx Hl'].
(* Exact *)
rewrite Hx.
now rewrite Zrnd_Z2R.
rewrite Zrnd_Z2R...
(* not Exact *)
unfold Zrnd, rndNE, rndN, Znearest.
unfold Znearest.
assert (Hm: Zfloor x = m).
apply Zfloor_imp.
exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)).
......@@ -387,8 +387,8 @@ Qed.
Theorem inbetween_int_N_sign :
forall choice x m l,
inbetween_int m (Rabs x) l ->
Zrnd (rndN choice) x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (if Rlt_bool x 0 then negb (choice (-(m + 1))%Z) else choice m) l) m).
Proof.
Znearest choice x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (if Rlt_bool x 0 then negb (choice (-(m + 1))%Z) else choice m) l) m).
Proof with auto with typeclass_instances.
intros choice x m l Hl.
simpl.
unfold Rabs in Hl.
......@@ -401,7 +401,7 @@ rewrite Znearest_opp.
apply f_equal.
inversion_clear Hl as [Hx|l' Hx Hl'].
rewrite Hx.
apply Znearest_Z2R.
apply Zrnd_Z2R...
assert (Hm: Zfloor (-x) = m).
apply Zfloor_imp.
exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)).
......@@ -425,7 +425,7 @@ rewrite Rlt_bool_false with (1 := Zx).
simpl.
inversion_clear Hl as [Hx|l' Hx Hl'].
rewrite Hx.
apply Znearest_Z2R.
apply Zrnd_Z2R...
assert (Hm: Zfloor x = m).
apply Zfloor_imp.
exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)).
......@@ -449,7 +449,7 @@ Qed.
Theorem inbetween_int_NE :
forall x m l,
inbetween_int m x l ->
Zrnd rndNE x = cond_incr (round_N (negb (Zeven m)) l) m.
ZnearestE x = cond_incr (round_N (negb (Zeven m)) l) m.
Proof.
intros x m l Hl.
now apply inbetween_int_N with (choice := fun x => negb (Zeven x)).
......@@ -459,7 +459,7 @@ Theorem inbetween_float_NE :
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l ->
round beta fexp rndNE x = F2R (Float beta (cond_incr (round_N (negb (Zeven m)) l) m) e).
round beta fexp ZnearestE x = F2R (Float beta (cond_incr (round_N (negb (Zeven m)) l) m) e).
Proof.
apply inbetween_float_round with (choice := fun m l => cond_incr (round_N (negb (Zeven m)) l) m).
exact inbetween_int_NE.
......@@ -468,7 +468,7 @@ Qed.
Theorem inbetween_int_NE_sign :
forall x m l,
inbetween_int m (Rabs x) l ->
Zrnd rndNE x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (negb (Zeven m)) l) m).
ZnearestE x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (negb (Zeven m)) l) m).
Proof.
intros x m l Hl.
erewrite inbetween_int_N_sign with (choice := fun x => negb (Zeven x)).
......@@ -484,7 +484,7 @@ Theorem inbetween_float_NE_sign :
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e (Rabs x) l ->
round beta fexp rndNE x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (negb (Zeven m)) l) m)) e).
round beta fexp ZnearestE x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (cond_incr (round_N (negb (Zeven m)) l) m)) e).
Proof.
apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_N (negb (Zeven m)) l) m).
exact inbetween_int_NE_sign.
......@@ -495,7 +495,7 @@ Qed.
Theorem inbetween_int_NA :
forall x m l,
inbetween_int m x l ->
Zrnd rndNA x = cond_incr (round_N (Zle_bool 0 m) l) m.
ZnearestA x = cond_incr (round_N (Zle_bool 0 m) l) m.
Proof.
intros x m l Hl.
now apply inbetween_int_N with (choice := fun x => Zle_bool 0 x).
......@@ -505,7 +505,7 @@ Theorem inbetween_float_NA :
forall x m l,
let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l ->
round beta fexp rndNA x = F2R (Float beta (cond_incr (round_N (Zle_bool 0 m) l) m) e).
round beta fexp ZnearestA x = F2R (Float beta (cond_incr (round_N (Zle_bool 0 m) l) m) e).
Proof.
apply inbetween_float_round with (choice := fun m l => cond_incr (round_N (Zle_bool 0 m) l) m).
exact inbetween_int_NA.
......@@ -514,7 +514,7 @@ Qed.
Theorem inbetween_int_NA_sign :
forall x m l,
inbetween_int m (Rabs x) l ->
Zrnd rndNA x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_N true l) m).
ZnearestA x = cond_Zopp (Rlt_bool x 0) (cond_incr (round_N true l) m).
Proof.
intros x m l Hl.
erewrite inbetween_int_N_sign with (choice := Zle_bool 0).
......@@ -829,19 +829,21 @@ Qed.
Section round_dir.
Variable rnd: Zround.
Variable rnd : R -> Z.
Context { valid_rnd : Valid_rnd rnd }.
Variable choice : Z -> location -> Z.
Hypothesis inbetween_int_valid :
forall x m l,
inbetween_int m x l ->
Zrnd rnd x = choice m l.
rnd x = choice m l.
Theorem round_any_correct :
forall x m e l,
inbetween_float beta m e x l ->
(e = canonic_exponent beta fexp x \/ (l = loc_Exact /\ format x)) ->
round beta fexp rnd x = F2R (Float beta (choice m l) e).
Proof.
Proof with auto with typeclass_instances.
intros x m e l Hin [He|(Hl,Hf)].
rewrite He in Hin |- *.
apply inbetween_float_round with (2 := Hin).
......@@ -851,7 +853,7 @@ inversion_clear Hin.
rewrite Hl.
replace (choice m loc_Exact) with m.
rewrite <- H.
now apply round_generic.
apply round_generic...
rewrite <- (Zrnd_Z2R rnd m) at 1.
apply inbetween_int_valid.
now constructor.
......@@ -877,19 +879,21 @@ End round_dir.
Section round_dir_sign.
Variable rnd: Zround.
Variable rnd : R -> Z.
Context { valid_rnd : Valid_rnd rnd }.
Variable choice : bool -> Z -> location -> Z.
Hypothesis inbetween_int_valid :
forall x m l,
inbetween_int m (Rabs x) l ->
Zrnd rnd x = cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m l).
rnd x = cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m l).
Theorem round_sign_any_correct :
forall x m e l,
inbetween_float beta m e (Rabs x) l ->
(e = canonic_exponent beta fexp x \/ (l = loc_Exact /\ format x)) ->
round beta fexp rnd x = F2R (Float beta (cond_Zopp (Rlt_bool x 0) (choice (Rlt_bool x 0) m l)) e).
Proof.
Proof with auto with typeclass_instances.
intros x m e l Hin [He|(Hl,Hf)].
rewrite He in Hin |- *.
apply inbetween_float_round_sign with (2 := Hin).
......@@ -905,7 +909,7 @@ rewrite Rlt_bool_true with (1 := Zx).
simpl.
rewrite <- opp_F2R.
rewrite <- H, Ropp_involutive.
now apply round_generic.
apply round_generic...
rewrite Rlt_bool_false.
simpl.
rewrite <- H.
......
......@@ -236,30 +236,16 @@ Qed.
Section FTZ_round.
(** Rounding with FTZ *)
Hypothesis rnd : Zround.
Variable rnd : R -> Z.
Context { valid_rnd : Valid_rnd rnd }.
Definition Zrnd_FTZ x :=
if Rle_bool R1 (Rabs x) then Zrnd rnd x else Z0.
if Rle_bool R1 (Rabs x) then rnd x else Z0.
Theorem Z_FTZ_Z2R :
forall n, Zrnd_FTZ (Z2R n) = n.
Proof.
intros n.
unfold Zrnd_FTZ.
rewrite Zrnd_Z2R.
case Rle_bool_spec.
easy.
rewrite <- Z2R_abs.
intros H.
generalize (lt_Z2R _ 1 H).
clear.
now case n ; trivial ; simpl ; intros [p|p|].
Qed.
Theorem Z_FTZ_monotone :
forall x y, (x <= y)%R ->
(Zrnd_FTZ x <= Zrnd_FTZ y)%Z.
Proof.
Global Instance valid_rnd_FTZ : Valid_rnd Zrnd_FTZ.
Proof with auto with typeclass_instances.
split.
(* *)
intros x y Hxy.
unfold Zrnd_FTZ.
case Rle_bool_spec ; intros Hx ;
......@@ -268,7 +254,7 @@ case Rle_bool_spec ; intros Hx ;
(* 1 <= |x| *)
now apply Zrnd_monotone.
rewrite <- (Zrnd_Z2R rnd 0).
apply Zrnd_monotone.
apply Zrnd_monotone...
apply Rle_trans with (Z2R (-1)). 2: now apply Z2R_le.
destruct (Rabs_ge_inv _ _ Hx) as [Hx1|Hx1].
exact Hx1.
......@@ -278,7 +264,7 @@ apply Rle_trans with (1 := Hxy).
apply RRle_abs.
(* |x| < 1 *)
rewrite <- (Zrnd_Z2R rnd 0).
apply Zrnd_monotone.
apply Zrnd_monotone...
apply Rle_trans with (Z2R 1).
now apply Z2R_le.
destruct (Rabs_ge_inv _ _ Hy) as [Hy1|Hy1].
......@@ -286,14 +272,23 @@ elim Rle_not_lt with (1 := Hy1).
apply Rlt_le_trans with (2 := Hxy).
apply (Rabs_def2 _ _ Hx).
exact Hy1.