Commit 614a6aac authored by Guillaume Melquiond's avatar Guillaume Melquiond

Use Zeven definition and theorems from the standard library.

parent 70d42306
...@@ -510,12 +510,12 @@ apply f_equal; unfold FLT_exp. ...@@ -510,12 +510,12 @@ apply f_equal; unfold FLT_exp.
rewrite Z.max_l. rewrite Z.max_l.
ring. ring.
omega. omega.
assert ((Zeven (Zfloor (scaled_mantissa radix2 (FLT_exp emin prec) (f + h)))) = false). assert ((Z.even (Zfloor (scaled_mantissa radix2 (FLT_exp emin prec) (f + h)))) = false).
replace (Zfloor (scaled_mantissa radix2 (FLT_exp emin prec) (f + h))) replace (Zfloor (scaled_mantissa radix2 (FLT_exp emin prec) (f + h)))
with (Zpower radix2 prec -1)%Z. with (Zpower radix2 prec -1)%Z.
unfold Zminus; rewrite Zeven_plus. unfold Zminus; rewrite Z.even_add.
rewrite Zeven_opp. rewrite Z.even_opp.
rewrite Zeven_Zpower. rewrite Z.even_pow.
reflexivity. reflexivity.
unfold Prec_gt_0 in prec_gt_0_; omega. unfold Prec_gt_0 in prec_gt_0_; omega.
apply eq_IZR. apply eq_IZR.
...@@ -1086,7 +1086,7 @@ apply Rle_lt_trans with (-(((IZR z) /2) - IZR (ZnearestE (IZR z / 2)))). ...@@ -1086,7 +1086,7 @@ apply Rle_lt_trans with (-(((IZR z) /2) - IZR (ZnearestE (IZR z / 2)))).
right; ring. right; ring.
apply Rle_lt_trans with (1:= RRle_abs _). apply Rle_lt_trans with (1:= RRle_abs _).
rewrite Rabs_Ropp. rewrite Rabs_Ropp.
apply Rle_lt_trans with (1:=Znearest_N (fun x => negb (Zeven x)) _). apply Rle_lt_trans with (1:=Znearest_N (fun x => negb (Z.even x)) _).
apply Rle_lt_trans with (1*/2);[right; ring|idtac]. apply Rle_lt_trans with (1*/2);[right; ring|idtac].
apply Rlt_le_trans with ((IZR z)*/2);[idtac|right; field]. apply Rlt_le_trans with ((IZR z)*/2);[idtac|right; field].
apply Rmult_lt_compat_r. apply Rmult_lt_compat_r.
......
...@@ -1242,8 +1242,8 @@ apply Rplus_le_compat_r. ...@@ -1242,8 +1242,8 @@ apply Rplus_le_compat_r.
apply IZR_le, kLe2. apply IZR_le, kLe2.
rewrite minus_IZR; simpl. rewrite minus_IZR; simpl.
generalize (beta); intros n. generalize (beta); intros n.
case (Zeven_odd_dec n); intros V. case (Z.even_odd_dec n); intros V.
apply Zeven_ex_iff in V; destruct V as (m, Hm). apply Z.even_ex_iff in V; destruct V as (m, Hm).
rewrite Hm, mult_IZR. rewrite Hm, mult_IZR.
replace (2*IZR m / 2) with (IZR m). replace (2*IZR m / 2) with (IZR m).
rewrite Zceil_IZR. rewrite Zceil_IZR.
......
...@@ -410,7 +410,7 @@ Definition new_location_even k l := ...@@ -410,7 +410,7 @@ Definition new_location_even k l :=
end. end.
Theorem new_location_even_correct : Theorem new_location_even_correct :
Zeven nb_steps = true -> Z.even nb_steps = true ->
forall x k l, (0 <= k < nb_steps)%Z -> forall x k l, (0 <= k < nb_steps)%Z ->
inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l -> inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l ->
inbetween start (start + IZR nb_steps * step) x (new_location_even k l). inbetween start (start + IZR nb_steps * step) x (new_location_even k l).
...@@ -467,7 +467,7 @@ Definition new_location_odd k l := ...@@ -467,7 +467,7 @@ Definition new_location_odd k l :=
end. end.
Theorem new_location_odd_correct : Theorem new_location_odd_correct :
Zeven nb_steps = false -> Z.even nb_steps = false ->
forall x k l, (0 <= k < nb_steps)%Z -> forall x k l, (0 <= k < nb_steps)%Z ->
inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l -> inbetween (start + IZR k * step) (start + IZR (k + 1) * step) x l ->
inbetween start (start + IZR nb_steps * step) x (new_location_odd k l). inbetween start (start + IZR nb_steps * step) x (new_location_odd k l).
...@@ -504,7 +504,7 @@ apply Hk. ...@@ -504,7 +504,7 @@ apply Hk.
Qed. Qed.
Definition new_location := Definition new_location :=
if Zeven nb_steps then new_location_even else new_location_odd. if Z.even nb_steps then new_location_even else new_location_odd.
Theorem new_location_correct : Theorem new_location_correct :
forall x k l, (0 <= k < nb_steps)%Z -> forall x k l, (0 <= k < nb_steps)%Z ->
......
...@@ -444,34 +444,34 @@ Qed. ...@@ -444,34 +444,34 @@ Qed.
Theorem inbetween_int_NE : Theorem inbetween_int_NE :
forall x m l, forall x m l,
inbetween_int m x l -> inbetween_int m x l ->
ZnearestE x = cond_incr (round_N (negb (Zeven m)) l) m. ZnearestE x = cond_incr (round_N (negb (Z.even m)) l) m.
Proof. Proof.
intros x m l Hl. intros x m l Hl.
now apply inbetween_int_N with (choice := fun x => negb (Zeven x)). now apply inbetween_int_N with (choice := fun x => negb (Z.even x)).
Qed. Qed.
Theorem inbetween_float_NE : Theorem inbetween_float_NE :
forall x m l, forall x m l,
let e := cexp beta fexp x in let e := cexp beta fexp x in
inbetween_float beta m e x l -> inbetween_float beta m e x l ->
round beta fexp ZnearestE 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 (Z.even m)) l) m) e).
Proof. Proof.
apply inbetween_float_round with (choice := fun m l => cond_incr (round_N (negb (Zeven m)) l) m). apply inbetween_float_round with (choice := fun m l => cond_incr (round_N (negb (Z.even m)) l) m).
exact inbetween_int_NE. exact inbetween_int_NE.
Qed. Qed.
Theorem inbetween_int_NE_sign : Theorem inbetween_int_NE_sign :
forall x m l, forall x m l,
inbetween_int m (Rabs x) l -> inbetween_int m (Rabs x) l ->
ZnearestE 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 (Z.even m)) l) m).
Proof. Proof.
intros x m l Hl. intros x m l Hl.
erewrite inbetween_int_N_sign with (choice := fun x => negb (Zeven x)). erewrite inbetween_int_N_sign with (choice := fun x => negb (Z.even x)).
2: eexact Hl. 2: eexact Hl.
apply f_equal. apply f_equal.
case Rlt_bool. case Rlt_bool.
rewrite Zeven_opp, Zeven_plus. rewrite Z.even_opp, Z.even_add.
now case (Zeven m). now case (Z.even m).
apply refl_equal. apply refl_equal.
Qed. Qed.
...@@ -479,9 +479,9 @@ Theorem inbetween_float_NE_sign : ...@@ -479,9 +479,9 @@ Theorem inbetween_float_NE_sign :
forall x m l, forall x m l,
let e := cexp beta fexp x in let e := cexp beta fexp x in
inbetween_float beta m e (Rabs x) l -> inbetween_float beta m e (Rabs x) l ->
round beta fexp ZnearestE 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 (Z.even m)) l) m)) e).
Proof. Proof.
apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_N (negb (Zeven m)) l) m). apply inbetween_float_round_sign with (choice := fun s m l => cond_incr (round_N (negb (Z.even m)) l) m).
exact inbetween_int_NE_sign. exact inbetween_int_NE_sign.
Qed. Qed.
...@@ -801,7 +801,7 @@ rewrite Zdiv_0_l, Zmod_0_l. ...@@ -801,7 +801,7 @@ rewrite Zdiv_0_l, Zmod_0_l.
eexists. eexists.
apply f_equal. apply f_equal.
unfold new_location. unfold new_location.
now case Zeven. now case Z.even.
now eexists. now eexists.
destruct H as (e', H). destruct H as (e', H).
rewrite H. rewrite H.
...@@ -1008,16 +1008,16 @@ Definition round_trunc_sign_ZR_correct := ...@@ -1008,16 +1008,16 @@ Definition round_trunc_sign_ZR_correct :=
round_trunc_sign_any_correct _ (fun s m l => m) inbetween_int_ZR_sign. round_trunc_sign_any_correct _ (fun s m l => m) inbetween_int_ZR_sign.
Definition round_NE_correct := Definition round_NE_correct :=
round_any_correct _ (fun m l => cond_incr (round_N (negb (Zeven m)) l) m) inbetween_int_NE. round_any_correct _ (fun m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE.
Definition round_trunc_NE_correct := Definition round_trunc_NE_correct :=
round_trunc_any_correct _ (fun m l => cond_incr (round_N (negb (Zeven m)) l) m) inbetween_int_NE. round_trunc_any_correct _ (fun m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE.
Definition round_sign_NE_correct := Definition round_sign_NE_correct :=
round_sign_any_correct _ (fun s m l => cond_incr (round_N (negb (Zeven m)) l) m) inbetween_int_NE_sign. round_sign_any_correct _ (fun s m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE_sign.
Definition round_trunc_sign_NE_correct := Definition round_trunc_sign_NE_correct :=
round_trunc_sign_any_correct _ (fun s m l => cond_incr (round_N (negb (Zeven m)) l) m) inbetween_int_NE_sign. round_trunc_sign_any_correct _ (fun s m l => cond_incr (round_N (negb (Z.even m)) l) m) inbetween_int_NE_sign.
Definition round_NA_correct := Definition round_NA_correct :=
round_any_correct _ (fun m l => cond_incr (round_N (Zle_bool 0 m) l) m) inbetween_int_NA. round_any_correct _ (fun m l => cond_incr (round_N (Zle_bool 0 m) l) m) inbetween_int_NA.
......
...@@ -47,7 +47,7 @@ Definition Fsqrt_core prec m e := ...@@ -47,7 +47,7 @@ Definition Fsqrt_core prec m e :=
let d := Zdigits beta m in let d := Zdigits beta m in
let s := Zmax (2 * prec - d) 0 in let s := Zmax (2 * prec - d) 0 in
let e' := (e - s)%Z in let e' := (e - s)%Z in
let (s', e'') := if Zeven e' then (s, e') else (s + 1, e' - 1)%Z in let (s', e'') := if Z.even e' then (s, e') else (s + 1, e' - 1)%Z in
let m' := let m' :=
match s' with match s' with
| Zpos p => (m * Zpower_pos beta p)%Z | Zpos p => (m * Zpower_pos beta p)%Z
...@@ -71,11 +71,11 @@ unfold Fsqrt_core. ...@@ -71,11 +71,11 @@ unfold Fsqrt_core.
set (d := Zdigits beta m). set (d := Zdigits beta m).
set (s := Zmax (2 * prec - d) 0). set (s := Zmax (2 * prec - d) 0).
(* . exponent *) (* . exponent *)
case_eq (if Zeven (e - s) then (s, (e - s)%Z) else ((s + 1)%Z, (e - s - 1)%Z)). case_eq (if Z.even (e - s) then (s, (e - s)%Z) else ((s + 1)%Z, (e - s - 1)%Z)).
intros s' e' Hse. intros s' e' Hse.
assert (He: (Zeven e' = true /\ 0 <= s' /\ 2 * prec - d <= s' /\ s' + e' = e)%Z). assert (He: (Z.even e' = true /\ 0 <= s' /\ 2 * prec - d <= s' /\ s' + e' = e)%Z).
revert Hse. revert Hse.
case_eq (Zeven (e - s)) ; intros He Hse ; inversion Hse. case_eq (Z.even (e - s)) ; intros He Hse ; inversion Hse.
repeat split. repeat split.
exact He. exact He.
unfold s. unfold s.
...@@ -87,7 +87,7 @@ fold s. ...@@ -87,7 +87,7 @@ fold s.
apply Zle_succ. apply Zle_succ.
repeat split. repeat split.
unfold Zminus at 1. unfold Zminus at 1.
now rewrite Zeven_plus, He. now rewrite Z.even_add, He.
apply Zle_trans with (2 := H). apply Zle_trans with (2 := H).
apply Zle_max_r. apply Zle_max_r.
apply Zle_trans with (2 := H). apply Zle_trans with (2 := H).
......
...@@ -304,7 +304,7 @@ zify ; omega. ...@@ -304,7 +304,7 @@ zify ; omega.
Qed. Qed.
(** and it allows a rounding to nearest, ties to even. *) (** and it allows a rounding to nearest, ties to even. *)
Hypothesis NE_prop : Zeven beta = false \/ (1 < prec)%Z. Hypothesis NE_prop : Z.even beta = false \/ (1 < prec)%Z.
Global Instance exists_NE_FLT : Exists_NE beta FLT_exp. Global Instance exists_NE_FLT : Exists_NE beta FLT_exp.
Proof. Proof.
......
...@@ -251,7 +251,7 @@ now apply Zplus_le_compat_r. ...@@ -251,7 +251,7 @@ now apply Zplus_le_compat_r.
Qed. Qed.
(** and it allows a rounding to nearest, ties to even. *) (** and it allows a rounding to nearest, ties to even. *)
Hypothesis NE_prop : Zeven beta = false \/ (1 < prec)%Z. Hypothesis NE_prop : Z.even beta = false \/ (1 < prec)%Z.
Global Instance exists_NE_FLX : Exists_NE beta FLX_exp. Global Instance exists_NE_FLX : Exists_NE beta FLX_exp.
Proof. Proof.
......
...@@ -20,7 +20,7 @@ COPYING file for more details. ...@@ -20,7 +20,7 @@ COPYING file for more details.
(** * Rounding to nearest, ties to even: existence, unicity... *) (** * Rounding to nearest, ties to even: existence, unicity... *)
Require Import Raux Defs Round_pred Generic_fmt Float_prop Ulp. Require Import Raux Defs Round_pred Generic_fmt Float_prop Ulp.
Notation ZnearestE := (Znearest (fun x => negb (Zeven x))). Notation ZnearestE := (Znearest (fun x => negb (Z.even x))).
Section Fcore_rnd_NE. Section Fcore_rnd_NE.
...@@ -36,7 +36,7 @@ Notation format := (generic_format beta fexp). ...@@ -36,7 +36,7 @@ Notation format := (generic_format beta fexp).
Notation canonical := (canonical beta fexp). Notation canonical := (canonical beta fexp).
Definition NE_prop (_ : R) f := Definition NE_prop (_ : R) f :=
exists g : float beta, f = F2R g /\ canonical g /\ Zeven (Fnum g) = true. exists g : float beta, f = F2R g /\ canonical g /\ Z.even (Fnum g) = true.
Definition Rnd_NE_pt := Definition Rnd_NE_pt :=
Rnd_NG_pt format NE_prop. Rnd_NG_pt format NE_prop.
...@@ -49,7 +49,7 @@ Definition DN_UP_parity_pos_prop := ...@@ -49,7 +49,7 @@ Definition DN_UP_parity_pos_prop :=
canonical xu -> canonical xu ->
F2R xd = round beta fexp Zfloor x -> F2R xd = round beta fexp Zfloor x ->
F2R xu = round beta fexp Zceil x -> F2R xu = round beta fexp Zceil x ->
Zeven (Fnum xu) = negb (Zeven (Fnum xd)). Z.even (Fnum xu) = negb (Z.even (Fnum xd)).
Definition DN_UP_parity_prop := Definition DN_UP_parity_prop :=
forall x xd xu, forall x xd xu,
...@@ -58,7 +58,7 @@ Definition DN_UP_parity_prop := ...@@ -58,7 +58,7 @@ Definition DN_UP_parity_prop :=
canonical xu -> canonical xu ->
F2R xd = round beta fexp Zfloor x -> F2R xd = round beta fexp Zfloor x ->
F2R xu = round beta fexp Zceil x -> F2R xu = round beta fexp Zceil x ->
Zeven (Fnum xu) = negb (Zeven (Fnum xd)). Z.even (Fnum xu) = negb (Z.even (Fnum xd)).
Lemma DN_UP_parity_aux : Lemma DN_UP_parity_aux :
DN_UP_parity_pos_prop -> DN_UP_parity_pos_prop ->
...@@ -78,11 +78,11 @@ now rewrite Ropp_involutive, Ropp_0. ...@@ -78,11 +78,11 @@ now rewrite Ropp_involutive, Ropp_0.
destruct xd as (md, ed). destruct xd as (md, ed).
destruct xu as (mu, eu). destruct xu as (mu, eu).
simpl. simpl.
rewrite <- (Bool.negb_involutive (Zeven mu)). rewrite <- (Bool.negb_involutive (Z.even mu)).
apply f_equal. apply f_equal.
apply sym_eq. apply sym_eq.
rewrite <- (Zeven_opp mu), <- (Zeven_opp md). rewrite <- (Z.even_opp mu), <- (Z.even_opp md).
change (Zeven (Fnum (Float beta (-md) ed)) = negb (Zeven (Fnum (Float beta (-mu) eu)))). change (Z.even (Fnum (Float beta (-md) ed)) = negb (Z.even (Fnum (Float beta (-mu) eu)))).
apply (Hpos (-x)%R _ _ Hx'). apply (Hpos (-x)%R _ _ Hx').
intros H. intros H.
apply Hfx. apply Hfx.
...@@ -97,7 +97,7 @@ now apply f_equal. ...@@ -97,7 +97,7 @@ now apply f_equal.
Qed. Qed.
Class Exists_NE := Class Exists_NE :=
exists_NE : Zeven beta = false \/ forall e, exists_NE : Z.even beta = false \/ forall e,
((fexp e < e)%Z -> (fexp (e + 1) < e)%Z) /\ ((e <= fexp e)%Z -> fexp (fexp e + 1) = fexp e). ((fexp e < e)%Z -> (fexp (e + 1) < e)%Z) /\ ((e <= fexp e)%Z -> fexp (fexp e + 1) = fexp e).
Context { exists_NE_ : Exists_NE }. Context { exists_NE_ : Exists_NE }.
...@@ -203,18 +203,18 @@ apply sym_eq. ...@@ -203,18 +203,18 @@ apply sym_eq.
now apply mag_unique. now apply mag_unique.
rewrite Hd3, Hu3. rewrite Hd3, Hu3.
unfold Fnum. unfold Fnum.
rewrite Zeven_mult. simpl. rewrite Z.even_mul. simpl.
unfold Zminus at 2. unfold Zminus at 2.
rewrite Zeven_plus. rewrite Z.even_add.
rewrite eqb_sym. simpl. rewrite eqb_sym. simpl.
fold (negb (Zeven (beta ^ (ex - fexp ex)))). fold (negb (Z.even (beta ^ (ex - fexp ex)))).
rewrite Bool.negb_involutive. rewrite Bool.negb_involutive.
rewrite (Zeven_Zpower beta (ex - fexp ex)). 2: omega. rewrite (Z.even_pow beta (ex - fexp ex)). 2: omega.
destruct exists_NE_. destruct exists_NE_.
rewrite H. rewrite H.
apply Zeven_Zpower_odd with (2 := H). apply Zeven_Zpower_odd with (2 := H).
now apply Zle_minus_le_0. now apply Zle_minus_le_0.
apply Zeven_Zpower. apply Z.even_pow.
specialize (H ex). specialize (H ex).
omega. omega.
(* - xu < bpow ex *) (* - xu < bpow ex *)
...@@ -228,7 +228,7 @@ rewrite mag_unique with (1 := Hd4). ...@@ -228,7 +228,7 @@ rewrite mag_unique with (1 := Hd4).
rewrite mag_unique with (1 := Hexa). rewrite mag_unique with (1 := Hexa).
intros H. intros H.
replace (Fnum xu) with (Fnum xd + 1)%Z. replace (Fnum xu) with (Fnum xd + 1)%Z.
rewrite Zeven_plus. rewrite Z.even_add.
now apply eqb_sym. now apply eqb_sym.
apply sym_eq. apply sym_eq.
apply eq_IZR. apply eq_IZR.
...@@ -268,7 +268,7 @@ unfold generic_format. ...@@ -268,7 +268,7 @@ unfold generic_format.
set (ed := cexp beta fexp d). set (ed := cexp beta fexp d).
set (md := Ztrunc (scaled_mantissa beta fexp d)). set (md := Ztrunc (scaled_mantissa beta fexp d)).
intros Hd1. intros Hd1.
case_eq (Zeven md) ; [ intros He | intros Ho ]. case_eq (Z.even md) ; [ intros He | intros Ho ].
right. right.
exists (Float beta md ed). exists (Float beta md ed).
unfold Generic_fmt.canonical. unfold Generic_fmt.canonical.
...@@ -358,9 +358,9 @@ unfold xr, round, Znearest. ...@@ -358,9 +358,9 @@ unfold xr, round, Znearest.
fold mx. fold mx.
rewrite Hm. rewrite Hm.
rewrite Rcompare_Eq. 2: apply refl_equal. rewrite Rcompare_Eq. 2: apply refl_equal.
case_eq (Zeven (Zfloor mx)) ; intros Hmx. case_eq (Z.even (Zfloor mx)) ; intros Hmx.
(* . even floor *) (* . even floor *)
change (Zeven (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zfloor x))) = true). change (Z.even (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zfloor x))) = true).
destruct (Rle_or_lt (round beta fexp Zfloor x) 0) as [Hr|Hr]. destruct (Rle_or_lt (round beta fexp Zfloor x) 0) as [Hr|Hr].
rewrite (Rle_antisym _ _ Hr). rewrite (Rle_antisym _ _ Hr).
unfold scaled_mantissa. unfold scaled_mantissa.
...@@ -372,7 +372,7 @@ now apply Rlt_le. ...@@ -372,7 +372,7 @@ now apply Rlt_le.
rewrite scaled_mantissa_DN... rewrite scaled_mantissa_DN...
now rewrite Ztrunc_IZR. now rewrite Ztrunc_IZR.
(* . odd floor *) (* . odd floor *)
change (Zeven (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zceil x))) = true). change (Z.even (Ztrunc (scaled_mantissa beta fexp (round beta fexp Zceil x))) = true).
destruct (mag beta x) as (ex, Hex). destruct (mag beta x) as (ex, Hex).
specialize (Hex (Rgt_not_eq _ _ Hx)). specialize (Hex (Rgt_not_eq _ _ Hx)).
rewrite (Rabs_pos_eq _ (Rlt_le _ _ Hx)) in Hex. rewrite (Rabs_pos_eq _ (Rlt_le _ _ Hx)) in Hex.
...@@ -399,23 +399,23 @@ rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r. ...@@ -399,23 +399,23 @@ rewrite Rmult_assoc, <- bpow_plus, Zplus_opp_r, Rmult_1_r.
rewrite Ztrunc_IZR. rewrite Ztrunc_IZR.
fold mx. fold mx.
rewrite Hfc. rewrite Hfc.
now rewrite Zeven_plus, Hmx. now rewrite Z.even_add, Hmx.
(* ... u = bpow *) (* ... u = bpow *)
rewrite Hu'. rewrite Hu'.
unfold scaled_mantissa, cexp. unfold scaled_mantissa, cexp.
rewrite mag_bpow. rewrite mag_bpow.
rewrite <- bpow_plus, <- IZR_Zpower. rewrite <- bpow_plus, <- IZR_Zpower.
rewrite Ztrunc_IZR. rewrite Ztrunc_IZR.
case_eq (Zeven beta) ; intros Hr. case_eq (Z.even beta) ; intros Hr.
destruct exists_NE_ as [Hs|Hs]. destruct exists_NE_ as [Hs|Hs].
now rewrite Hs in Hr. now rewrite Hs in Hr.
destruct (Hs ex) as (H,_). destruct (Hs ex) as (H,_).
rewrite Zeven_Zpower. rewrite Z.even_pow.
exact Hr. exact Hr.
omega. omega.
assert (Zeven (Zfloor mx) = true). 2: now rewrite H in Hmx. assert (Z.even (Zfloor mx) = true). 2: now rewrite H in Hmx.
replace (Zfloor mx) with (Zceil mx + -1)%Z by omega. replace (Zfloor mx) with (Zceil mx + -1)%Z by omega.
rewrite Zeven_plus. rewrite Z.even_add.
apply eqb_true. apply eqb_true.
unfold mx. unfold mx.
replace (Zceil (scaled_mantissa beta fexp x)) with (Zpower beta (ex - fexp ex)). replace (Zceil (scaled_mantissa beta fexp x)) with (Zpower beta (ex - fexp ex)).
...@@ -435,7 +435,7 @@ apply bpow_gt_0. ...@@ -435,7 +435,7 @@ apply bpow_gt_0.
generalize (proj1 (valid_exp ex) He). generalize (proj1 (valid_exp ex) He).
omega. omega.
(* .. small pos *) (* .. small pos *)
assert (Zeven (Zfloor mx) = true). 2: now rewrite H in Hmx. assert (Z.even (Zfloor mx) = true). 2: now rewrite H in Hmx.
unfold mx, scaled_mantissa. unfold mx, scaled_mantissa.
rewrite cexp_fexp_pos with (1 := Hex). rewrite cexp_fexp_pos with (1 := Hex).
now rewrite mantissa_DN_small_pos. now rewrite mantissa_DN_small_pos.
...@@ -490,8 +490,8 @@ unfold Znearest. ...@@ -490,8 +490,8 @@ unfold Znearest.
case Rcompare ; trivial. case Rcompare ; trivial.
apply (f_equal (fun (b : bool) => if b then Zceil m else Zfloor m)). apply (f_equal (fun (b : bool) => if b then Zceil m else Zfloor m)).
rewrite Bool.negb_involutive. rewrite Bool.negb_involutive.
rewrite Zeven_opp. rewrite Z.even_opp.
rewrite Zeven_plus. rewrite Z.even_add.
now rewrite eqb_sym. now rewrite eqb_sym.
Qed. Qed.
...@@ -530,7 +530,7 @@ rewrite H1. ...@@ -530,7 +530,7 @@ rewrite H1.
now rewrite F2R_Zopp. now rewrite F2R_Zopp.
now apply canonical_opp. now apply canonical_opp.
simpl. simpl.
now rewrite Zeven_opp. now rewrite Z.even_opp.
rewrite <- round_NE_opp. rewrite <- round_NE_opp.
apply round_NE_pt_pos. apply round_NE_pt_pos.
now apply Ropp_0_gt_lt_contravar. now apply Ropp_0_gt_lt_contravar.
......
...@@ -69,29 +69,8 @@ End Proof_Irrelevance. ...@@ -69,29 +69,8 @@ End Proof_Irrelevance.
Section Even_Odd. Section Even_Odd.
(** Zeven, used for rounding to nearest, ties to even *)
Definition Zeven (n : Z) :=
match n with
| Zpos (xO _) => true
| Zneg (xO _) => true
| Z0 => true
| _ => false
end.
Theorem Zeven_mult :
forall x y, Zeven (x * y) = orb (Zeven x) (Zeven y).
Proof.
now intros [|[xp|xp|]|[xp|xp|]] [|[yp|yp|]|[yp|yp|]].
Qed.
Theorem Zeven_opp :
forall x, Zeven (- x) = Zeven x.
Proof.
now intros [|[n|n|]|[n|n|]].
Qed.
Theorem Zeven_ex : Theorem Zeven_ex :
forall x, exists p, x = (2 * p + if Zeven x then 0 else 1)%Z. forall x, exists p, x = (2 * p + if Z.even x then 0 else 1)%Z.
Proof. Proof.
intros [|[n|n|]|[n|n|]]. intros [|[n|n|]|[n|n|]].
now exists Z0. now exists Z0.
...@@ -105,37 +84,6 @@ now exists (Zneg n). ...@@ -105,37 +84,6 @@ now exists (Zneg n).
now exists (-1)%Z. now exists (-1)%Z.
Qed. Qed.
Theorem Zeven_2xp1 :
forall n, Zeven (2 * n + 1) = false.
Proof.
intros n.
destruct (Zeven_ex (2 * n + 1)) as (p, Hp).
revert Hp.
case (Zeven (2 * n + 1)) ; try easy.
intros H.
apply False_ind.
omega.
Qed.
Theorem Zeven_plus :
forall x y, Zeven (x + y) = Bool.eqb (Zeven x) (Zeven y).
Proof.
intros x y.
destruct (Zeven_ex x) as (px, Hx).
rewrite Hx at 1.