Commit 614a6aac by 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.