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. ...@@ -63,8 +63,8 @@ Qed.
Definition MinOrMax x f := Definition MinOrMax x f :=
((f = round beta (FLX_exp prec) rndDN x) ((f = round beta (FLX_exp prec) Zfloor x)
\/ (f = round beta (FLX_exp prec) rndUP x)). \/ (f = round beta (FLX_exp prec) Zceil x)).
Theorem MinOrMax_opp: forall x f, Theorem MinOrMax_opp: forall x f,
MinOrMax x f <-> MinOrMax (-x) (-f). MinOrMax x f <-> MinOrMax (-x) (-f).
...@@ -85,7 +85,7 @@ Theorem implies_DN_lt_ulp: ...@@ -85,7 +85,7 @@ Theorem implies_DN_lt_ulp:
forall x f, format f -> forall x f, format f ->
(0 < f <= x)%R -> (0 < f <= x)%R ->
(Rabs (f-x) < ulp f)%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. intros x f Hf Hxf1 Hxf2.
apply sym_eq. apply sym_eq.
replace x with (f+-(f-x))%R by ring. replace x with (f+-(f-x))%R by ring.
...@@ -160,8 +160,8 @@ Hypothesis Ha: format a. ...@@ -160,8 +160,8 @@ Hypothesis Ha: format a.
Hypothesis Hx: format x. Hypothesis Hx: format x.
Hypothesis Hy: format y. Hypothesis Hy: format y.
Notation t := (round beta (FLX_exp prec) (rndN choice) (a*x)). Notation t := (round beta (FLX_exp prec) (Znearest choice) (a*x)).
Notation u := (round beta (FLX_exp prec) (rndN choice) (t+y)). 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 Axpy_aux1 : lemma Closest?(b)(a*x,t) => Closest?(b)(t+y,u) => 0 < u
......
...@@ -52,6 +52,7 @@ Hypothesis Hmax : (prec < emax)%Z. ...@@ -52,6 +52,7 @@ Hypothesis Hmax : (prec < emax)%Z.
Let emin := (3 - emax - prec)%Z. Let emin := (3 - emax - prec)%Z.
Let fexp := FLT_exp emin prec. Let fexp := FLT_exp emin prec.
Instance fexp_correct : Valid_exp fexp := FLT_exp_valid 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 := Definition bounded_prec m e :=
Zeq_bool (fexp (Z_of_nat (S (digits2_Pnat m)) + e)) 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. ...@@ -526,11 +527,11 @@ Inductive mode := mode_NE | mode_ZR | mode_DN | mode_UP | mode_NA.
Definition round_mode m := Definition round_mode m :=
match m with match m with
| mode_NE => rndNE | mode_NE => ZnearestE
| mode_ZR => rndZR | mode_ZR => Ztrunc
| mode_DN => rndDN | mode_DN => Zfloor
| mode_UP => rndUP | mode_UP => Zceil
| mode_NA => rndNA | mode_NA => ZnearestA
end. end.
Definition choice_mode m sx mx lx := Definition choice_mode m sx mx lx :=
...@@ -542,6 +543,11 @@ 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 | mode_NA => cond_incr (round_N true lx) mx
end. 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 := Definition overflow_to_inf m s :=
match m with match m with
| mode_NE => true | mode_NE => true
...@@ -573,7 +579,7 @@ Theorem binary_round_sign_correct : ...@@ -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 FF2R radix2 (binary_round_sign mode (Rlt_bool x 0) mx ex lx) = round radix2 fexp (round_mode mode) x
else else
binary_round_sign mode (Rlt_bool x 0) mx ex lx = binary_overflow mode (Rlt_bool x 0). 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. intros m x mx ex lx Bx Ex.
unfold binary_round_sign. unfold binary_round_sign.
rewrite shr_truncate. 2: easy. rewrite shr_truncate. 2: easy.
...@@ -627,9 +633,7 @@ rewrite <- ln_beta_F2R_digits, <- Hr, ln_beta_abs. ...@@ -627,9 +633,7 @@ rewrite <- ln_beta_F2R_digits, <- Hr, ln_beta_abs.
rewrite H1b. rewrite H1b.
rewrite canonic_exponent_abs. rewrite canonic_exponent_abs.
fold (canonic_exponent radix2 fexp (round radix2 fexp (round_mode m) x)). fold (canonic_exponent radix2 fexp (round radix2 fexp (round_mode m) x)).
apply canonic_exponent_round. apply canonic_exponent_round...
apply fexp_correct.
apply FLT_exp_monotone.
rewrite H1c. rewrite H1c.
case (Rlt_bool x 0). case (Rlt_bool x 0).
apply Rlt_not_eq. apply Rlt_not_eq.
...@@ -718,9 +722,8 @@ apply Rlt_trans with R0. ...@@ -718,9 +722,8 @@ apply Rlt_trans with R0.
now apply F2R_lt_0_compat. now apply F2R_lt_0_compat.
now apply F2R_gt_0_compat. now apply F2R_gt_0_compat.
rewrite <- Hr. rewrite <- Hr.
apply generic_format_abs. apply generic_format_abs...
apply generic_format_round. apply generic_format_round...
apply fexp_correct.
(* . not m1' < 0 *) (* . not m1' < 0 *)
elim Rgt_not_eq with (2 := Hr). elim Rgt_not_eq with (2 := Hr).
apply Rlt_le_trans with R0. apply Rlt_le_trans with R0.
...@@ -822,7 +825,7 @@ Theorem Bmult_correct : ...@@ -822,7 +825,7 @@ Theorem Bmult_correct :
B2FF (Bmult m x y) = binary_overflow m (xorb (Bsign x) (Bsign y)). B2FF (Bmult 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 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. simpl.
case Bmult_correct_aux. case Bmult_correct_aux.
intros H1 H2. intros H1 H2.
...@@ -978,22 +981,20 @@ Theorem Bplus_correct : ...@@ -978,22 +981,20 @@ Theorem Bplus_correct :
B2R (Bplus m x y) = round radix2 fexp (round_mode m) (B2R x + B2R y) B2R (Bplus m x y) = round radix2 fexp (round_mode m) (B2R x + B2R y)
else else
(B2FF (Bplus m x y) = binary_overflow m (Bsign x) /\ Bsign x = Bsign y). (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. 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. simpl.
case (Bool.eqb sx sy) ; try easy. case (Bool.eqb sx sy) ; try easy.
now case m. now case m.
apply bpow_gt_0. apply bpow_gt_0.
(* *) (* *)
rewrite Rplus_0_l, round_generic, Rlt_bool_true. rewrite Rplus_0_l, round_generic, Rlt_bool_true...
apply refl_equal.
apply B2R_lt_emax. apply B2R_lt_emax.
apply generic_format_B2R. apply generic_format_B2R.
(* *) (* *)
rewrite Rplus_0_r, round_generic, Rlt_bool_true. rewrite Rplus_0_r, round_generic, Rlt_bool_true...
apply refl_equal.
apply B2R_lt_emax. apply B2R_lt_emax.
apply generic_format_B2R. apply generic_format_B2R.
(* *) (* *)
...@@ -1058,15 +1059,13 @@ split. ...@@ -1058,15 +1059,13 @@ split.
apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)). apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)).
rewrite <- opp_F2R. rewrite <- opp_F2R.
now apply Ropp_lt_contravar. now apply Ropp_lt_contravar.
apply round_monotone_l. apply round_monotone_l...
apply fexp_correct.
now apply generic_format_canonic. now apply generic_format_canonic.
pattern (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)) at 1 ; rewrite <- Rplus_0_r. pattern (F2R (Float radix2 (cond_Zopp true (Zpos mx)) ex)) at 1 ; rewrite <- Rplus_0_r.
apply Rplus_le_compat_l. apply Rplus_le_compat_l.
now apply F2R_ge_0_compat. now apply F2R_ge_0_compat.
apply Rle_lt_trans with (2 := By). apply Rle_lt_trans with (2 := By).
apply round_monotone_r. apply round_monotone_r...
apply fexp_correct.
now apply generic_format_canonic. now apply generic_format_canonic.
rewrite <- (Rplus_0_l (F2R (Float radix2 (Zpos my) ey))). rewrite <- (Rplus_0_l (F2R (Float radix2 (Zpos my) ey))).
apply Rplus_le_compat_r. apply Rplus_le_compat_r.
...@@ -1080,22 +1079,20 @@ split. ...@@ -1080,22 +1079,20 @@ split.
apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)). apply Rlt_le_trans with (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)).
rewrite <- opp_F2R. rewrite <- opp_F2R.
now apply Ropp_lt_contravar. now apply Ropp_lt_contravar.
apply round_monotone_l. apply round_monotone_l...
apply fexp_correct.
now apply generic_format_canonic. now apply generic_format_canonic.
pattern (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)) at 1 ; rewrite <- Rplus_0_l. pattern (F2R (Float radix2 (cond_Zopp true (Zpos my)) ey)) at 1 ; rewrite <- Rplus_0_l.
apply Rplus_le_compat_r. apply Rplus_le_compat_r.
now apply F2R_ge_0_compat. now apply F2R_ge_0_compat.
apply Rle_lt_trans with (2 := Bx). apply Rle_lt_trans with (2 := Bx).
apply round_monotone_r. apply round_monotone_r...
apply fexp_correct.
now apply generic_format_canonic. now apply generic_format_canonic.
rewrite <- (Rplus_0_r (F2R (Float radix2 (Zpos mx) ex))). rewrite <- (Rplus_0_r (F2R (Float radix2 (Zpos mx) ex))).
apply Rplus_le_compat_l. apply Rplus_le_compat_l.
now apply F2R_le_0_compat. now apply F2R_le_0_compat.
destruct mz as [|mz|mz]. destruct mz as [|mz|mz].
(* . mz = 0 *) (* . 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. now case m.
apply bpow_gt_0. apply bpow_gt_0.
(* . mz > 0 *) (* . mz > 0 *)
...@@ -1253,7 +1250,7 @@ intros m x [sy|sy| |sy my ey Hy] Zy ; try now elim Zy. ...@@ -1253,7 +1250,7 @@ intros m x [sy|sy| |sy my ey Hy] Zy ; try now elim Zy.
revert x. revert x.
unfold Rdiv. unfold Rdiv.
intros [sx|sx| |sx mx ex Hx] ; 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. simpl.
case Bdiv_correct_aux. case Bdiv_correct_aux.
intros H1 H2. intros H1 H2.
...@@ -1275,7 +1272,7 @@ Lemma Bsqrt_correct_aux : ...@@ -1275,7 +1272,7 @@ Lemma Bsqrt_correct_aux :
end in end in
valid_binary z = true /\ valid_binary z = true /\
FF2R radix2 z = round radix2 fexp (round_mode m) (sqrt x). FF2R radix2 z = round radix2 fexp (round_mode m) (sqrt x).
Proof. Proof with auto with typeclass_instances.
intros m mx ex Hx. intros m mx ex Hx.
simpl. simpl.
refine (_ (Fsqrt_core_correct radix2 prec (Zpos mx) ex _)) ; try easy. refine (_ (Fsqrt_core_correct radix2 prec (Zpos mx) ex _)) ; try easy.
...@@ -1353,8 +1350,7 @@ apply generic_format_canonic. ...@@ -1353,8 +1350,7 @@ apply generic_format_canonic.
apply (canonic_bounded_prec false). apply (canonic_bounded_prec false).
apply (andb_prop _ _ Hx). apply (andb_prop _ _ Hx).
(* .. *) (* .. *)
apply round_monotone_l. apply round_monotone_l...
apply fexp_correct.
apply generic_format_0. apply generic_format_0.
apply sqrt_ge_0. apply sqrt_ge_0.
rewrite Rabs_pos_eq. rewrite Rabs_pos_eq.
...@@ -1389,7 +1385,7 @@ Theorem Bsqrt_correct : ...@@ -1389,7 +1385,7 @@ Theorem Bsqrt_correct :
forall m x, forall m x,
B2R (Bsqrt m x) = round radix2 fexp (round_mode m) (sqrt (B2R x)). B2R (Bsqrt m x) = round radix2 fexp (round_mode m) (sqrt (B2R x)).
Proof. 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. simpl.
case Bsqrt_correct_aux. case Bsqrt_correct_aux.
intros H1 H2. intros H1 H2.
...@@ -1399,6 +1395,7 @@ unfold sqrt. ...@@ -1399,6 +1395,7 @@ unfold sqrt.
case Rcase_abs. case Rcase_abs.
intros _. intros _.
apply round_0. apply round_0.
auto with typeclass_instances.
intros H. intros H.
elim Rge_not_lt with (1 := H). elim Rge_not_lt with (1 := H).
now apply F2R_lt_0_compat. now apply F2R_lt_0_compat.
......
...@@ -44,7 +44,7 @@ Theorem Fsqrt_FLT_ne_correct : ...@@ -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)). Rnd_NE_pt beta (FLT_exp emin prec) (sqrt (F2R x)) (F2R (Fsqrt_FLT_ne x)).
Proof with auto with typeclass_instances. Proof with auto with typeclass_instances.
intros x. 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... apply round_NE_pt...
unfold Fsqrt_FLT_ne. unfold Fsqrt_FLT_ne.
destruct x as (mx, ex). destruct x as (mx, ex).
...@@ -53,7 +53,7 @@ case (Zle_bool mx 0) ; intros Hm. ...@@ -53,7 +53,7 @@ case (Zle_bool mx 0) ; intros Hm.
(* mx = 0 *) (* mx = 0 *)
rewrite F2R_0. rewrite F2R_0.
replace (sqrt (F2R (Float beta mx ex))) with R0. replace (sqrt (F2R (Float beta mx ex))) with R0.
apply round_0. apply round_0...
destruct (Zle_lt_or_eq _ _ Hm) as [Hm'|Hm']. destruct (Zle_lt_or_eq _ _ Hm) as [Hm'|Hm'].
unfold sqrt. unfold sqrt.
case Rcase_abs ; intros Hs. case Rcase_abs ; intros Hs.
......
...@@ -38,7 +38,7 @@ Notation format := (generic_format beta fexp). ...@@ -38,7 +38,7 @@ Notation format := (generic_format beta fexp).
Theorem inbetween_float_round : Theorem inbetween_float_round :
forall rnd choice, 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, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l -> 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. ...@@ -58,7 +58,7 @@ Definition cond_incr (b : bool) m := if b then (m + 1)%Z else m.
Theorem inbetween_float_round_sign : Theorem inbetween_float_round_sign :
forall rnd choice, forall rnd choice,
( forall x m l, inbetween_int m (Rabs x) l -> ( 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, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float beta m e (Rabs x) l -> inbetween_float beta m e (Rabs x) l ->
...@@ -93,7 +93,7 @@ Qed. ...@@ -93,7 +93,7 @@ Qed.
Theorem inbetween_int_DN : Theorem inbetween_int_DN :
forall x m l, forall x m l,
inbetween_int m x l -> inbetween_int m x l ->
Zrnd rndDN x = m. Zfloor x = m.
Proof. Proof.
intros x m l Hl. intros x m l Hl.
refine (Zfloor_imp m _ _). refine (Zfloor_imp m _ _).
...@@ -106,7 +106,7 @@ Theorem inbetween_float_DN : ...@@ -106,7 +106,7 @@ Theorem inbetween_float_DN :
forall x m l, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l -> 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. Proof.
apply inbetween_float_round with (choice := fun m l => m). apply inbetween_float_round with (choice := fun m l => m).
exact inbetween_int_DN. exact inbetween_int_DN.
...@@ -121,7 +121,7 @@ Definition round_sign_DN s l := ...@@ -121,7 +121,7 @@ Definition round_sign_DN s l :=
Theorem inbetween_int_DN_sign : Theorem inbetween_int_DN_sign :
forall x m l, forall x m l,
inbetween_int m (Rabs x) 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. Proof.
intros x m l Hl. intros x m l Hl.
unfold Rabs in Hl. unfold Rabs in Hl.
...@@ -158,7 +158,7 @@ Theorem inbetween_float_DN_sign : ...@@ -158,7 +158,7 @@ Theorem inbetween_float_DN_sign :
forall x m l, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float beta m e (Rabs x) l -> 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. Proof.
apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_sign_DN s l) m). apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_sign_DN s l) m).
exact inbetween_int_DN_sign. exact inbetween_int_DN_sign.
...@@ -175,7 +175,7 @@ Definition round_UP l := ...@@ -175,7 +175,7 @@ Definition round_UP l :=
Theorem inbetween_int_UP : Theorem inbetween_int_UP :
forall x m l, forall x m l,
inbetween_int m x l -> inbetween_int m x l ->
Zrnd rndUP x = cond_incr (round_UP l) m. Zceil x = cond_incr (round_UP l) m.
Proof. Proof.
intros x m l Hl. intros x m l Hl.
assert (Hl': l = loc_Exact \/ (l <> loc_Exact /\ round_UP l = true)). assert (Hl': l = loc_Exact \/ (l <> loc_Exact /\ round_UP l = true)).
...@@ -199,7 +199,7 @@ Theorem inbetween_float_UP : ...@@ -199,7 +199,7 @@ Theorem inbetween_float_UP :
forall x m l, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l -> 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. Proof.
apply inbetween_float_round with (choice := fun m l => cond_incr (round_UP l) m). apply inbetween_float_round with (choice := fun m l => cond_incr (round_UP l) m).
exact inbetween_int_UP. exact inbetween_int_UP.
...@@ -214,7 +214,7 @@ Definition round_sign_UP s l := ...@@ -214,7 +214,7 @@ Definition round_sign_UP s l :=
Theorem inbetween_int_UP_sign : Theorem inbetween_int_UP_sign :
forall x m l, forall x m l,
inbetween_int m (Rabs x) 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. Proof.
intros x m l Hl. intros x m l Hl.
unfold Rabs in Hl. unfold Rabs in Hl.
...@@ -249,7 +249,7 @@ Theorem inbetween_float_UP_sign : ...@@ -249,7 +249,7 @@ Theorem inbetween_float_UP_sign :
forall x m l, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float beta m e (Rabs x) l -> 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. Proof.
apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_sign_UP s l) m). apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_sign_UP s l) m).
exact inbetween_int_UP_sign. exact inbetween_int_UP_sign.
...@@ -266,15 +266,15 @@ Definition round_ZR (s : bool) l := ...@@ -266,15 +266,15 @@ Definition round_ZR (s : bool) l :=
Theorem inbetween_int_ZR : Theorem inbetween_int_ZR :
forall x m l, forall x m l,
inbetween_int m x l -> inbetween_int m x l ->
Zrnd rndZR x = cond_incr (round_ZR (Zlt_bool m 0) l) m. Ztrunc x = cond_incr (round_ZR (Zlt_bool m 0) l) m.
Proof. Proof with auto with typeclass_instances.
intros x m l Hl. intros x m l Hl.
inversion_clear Hl as [Hx|l' Hx Hl']. inversion_clear Hl as [Hx|l' Hx Hl'].
(* Exact *) (* Exact *)
rewrite Hx. rewrite Hx.
now rewrite Zrnd_Z2R. rewrite Zrnd_Z2R...
(* not Exact *) (* not Exact *)
unfold Zrnd, rndZR, Ztrunc. unfold Ztrunc.
assert (Hm: Zfloor x = m). assert (Hm: Zfloor x = m).
apply Zfloor_imp. apply Zfloor_imp.
exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)). exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)).
...@@ -300,7 +300,7 @@ Theorem inbetween_float_ZR : ...@@ -300,7 +300,7 @@ Theorem inbetween_float_ZR :
forall x m l, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float beta m e x l -> 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. Proof.
apply inbetween_float_round with (choice := fun m l => cond_incr (round_ZR (Zlt_bool m 0) l) m). apply inbetween_float_round with (choice := fun m l => cond_incr (round_ZR (Zlt_bool m 0) l) m).
exact inbetween_int_ZR. exact inbetween_int_ZR.
...@@ -309,7 +309,7 @@ Qed. ...@@ -309,7 +309,7 @@ Qed.
Theorem inbetween_int_ZR_sign : Theorem inbetween_int_ZR_sign :
forall x m l, forall x m l,
inbetween_int m (Rabs x) 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. Proof.
intros x m l Hl. intros x m l Hl.
simpl. simpl.
...@@ -339,7 +339,7 @@ Theorem inbetween_float_ZR_sign : ...@@ -339,7 +339,7 @@ Theorem inbetween_float_ZR_sign :
forall x m l, forall x m l,
let e := canonic_exponent beta fexp x in let e := canonic_exponent beta fexp x in
inbetween_float beta m e (Rabs x) l -> 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. Proof.
apply inbetween_float_round_sign with (choice := fun s m l => m). apply inbetween_float_round_sign with (choice := fun s m l => m).
exact inbetween_int_ZR_sign. exact inbetween_int_ZR_sign.
...@@ -358,15 +358,15 @@ Definition round_N (p : bool) l := ...@@ -358,15 +358,15 @@ Definition round_N (p : bool) l :=
Theorem inbetween_int_N : Theorem inbetween_int_N :
forall choice x m l, forall choice x m l,
inbetween_int m x l -> inbetween_int m x l ->
Zrnd (rndN choice) x = cond_incr (round_N (choice m) l) m. Znearest choice x = cond_incr (round_N (choice m) l) m.
Proof. Proof with auto with typeclass_instances.
intros choice x m l Hl. intros choice x m l Hl.
inversion_clear Hl as [Hx|l' Hx Hl']. inversion_clear Hl as [Hx|l' Hx Hl'].
(* Exact *) (* Exact *)
rewrite Hx. rewrite Hx.
now rewrite Zrnd_Z2R. rewrite Zrnd_Z2R...
(* not Exact *) (* not Exact *)
unfold Zrnd, rndNE, rndN, Znearest. unfold Znearest.
assert (Hm: Zfloor x = m). assert (Hm: Zfloor x = m).
apply Zfloor_imp. apply Zfloor_imp.
exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)). exact (conj (Rlt_le _ _ (proj1 Hx)) (proj2 Hx)).
...@@ -387,8 +387,8 @@ Qed. ...@@ -387,8 +387,8 @@ Qed.
Theorem inbetween_int_N_sign : Theorem inbetween_int_N_sign :
forall choice x m l, forall choice x m l,
inbetween_int m (Rabs x) 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). 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. Proof with auto with typeclass_instances.
intros choice x m l Hl.