aboutsummaryrefslogtreecommitdiffstats
path: root/flocq
diff options
context:
space:
mode:
authorGuillaume Melquiond <guillaume.melquiond@inria.fr>2017-03-08 08:35:29 +0100
committerGuillaume Melquiond <guillaume.melquiond@inria.fr>2017-03-08 08:35:29 +0100
commit177c8fbc523a171e8c8470fa675f9a69ef7f99de (patch)
treef54d8315891bec2f741545991f420dd4407bccc0 /flocq
parent44b63eb13151ca5c3e83ee6a9e7eb6c0049c3758 (diff)
downloadcompcert-kvx-177c8fbc523a171e8c8470fa675f9a69ef7f99de.tar.gz
compcert-kvx-177c8fbc523a171e8c8470fa675f9a69ef7f99de.zip
Adapt proofs to future handling of literal constants in Coq.
This commit is mainly a squash of the relevant compatibility commits from Flocq's master. Most of the changes are meant to make the proofs oblivious to the way constants such as 0, 1, 2, and -1 are represented.
Diffstat (limited to 'flocq')
-rw-r--r--flocq/Appli/Fappli_IEEE.v10
-rw-r--r--flocq/Appli/Fappli_double_round.v30
-rw-r--r--flocq/Appli/Fappli_rnd_odd.v67
-rw-r--r--flocq/Core/Fcore_FLT.v2
-rw-r--r--flocq/Core/Fcore_FTZ.v8
-rw-r--r--flocq/Core/Fcore_Raux.v56
-rw-r--r--flocq/Core/Fcore_float_prop.v4
-rw-r--r--flocq/Core/Fcore_generic_fmt.v34
-rw-r--r--flocq/Core/Fcore_rnd_ne.v2
-rw-r--r--flocq/Core/Fcore_ulp.v21
-rw-r--r--flocq/Prop/Fprop_Sterbenz.v2
-rw-r--r--flocq/Prop/Fprop_div_sqrt_error.v9
-rw-r--r--flocq/Prop/Fprop_plus_error.v6
-rw-r--r--flocq/Prop/Fprop_relative.v13
14 files changed, 119 insertions, 145 deletions
diff --git a/flocq/Appli/Fappli_IEEE.v b/flocq/Appli/Fappli_IEEE.v
index 6400304b..b6ccd84f 100644
--- a/flocq/Appli/Fappli_IEEE.v
+++ b/flocq/Appli/Fappli_IEEE.v
@@ -39,7 +39,7 @@ Inductive full_float :=
Definition FF2R beta x :=
match x with
| F754_finite s m e => F2R (Float beta (cond_Zopp s (Zpos m)) e)
- | _ => R0
+ | _ => 0%R
end.
End AnyRadix.
@@ -104,7 +104,7 @@ Definition B2FF x :=
Definition B2R f :=
match f with
| B754_finite s m e _ => F2R (Float radix2 (cond_Zopp s (Zpos m)) e)
- | _ => R0
+ | _ => 0%R
end.
Theorem FF2R_B2FF :
@@ -346,11 +346,11 @@ Proof.
intros. destruct x, y; try (apply B2R_inj; now eauto).
- simpl in H2. congruence.
- symmetry in H1. apply Rmult_integral in H1.
- destruct H1. apply eq_Z2R with (n:=0%Z) in H1. destruct b0; discriminate H1.
+ destruct H1. apply (eq_Z2R _ 0) in H1. destruct b0; discriminate H1.
simpl in H1. pose proof (bpow_gt_0 radix2 e).
rewrite H1 in H3. apply Rlt_irrefl in H3. destruct H3.
- apply Rmult_integral in H1.
- destruct H1. apply eq_Z2R with (n:=0%Z) in H1. destruct b; discriminate H1.
+ destruct H1. apply (eq_Z2R _ 0) in H1. destruct b; discriminate H1.
simpl in H1. pose proof (bpow_gt_0 radix2 e).
rewrite H1 in H3. apply Rlt_irrefl in H3. destruct H3.
Qed.
@@ -1714,7 +1714,7 @@ Definition Bdiv div_nan m x y :=
Theorem Bdiv_correct :
forall div_nan m x y,
- B2R y <> R0 ->
+ B2R y <> 0%R ->
if Rlt_bool (Rabs (round radix2 fexp (round_mode m) (B2R x / B2R y))) (bpow radix2 emax) then
B2R (Bdiv div_nan m x y) = round radix2 fexp (round_mode m) (B2R x / B2R y) /\
is_finite (Bdiv div_nan m x y) = is_finite x /\
diff --git a/flocq/Appli/Fappli_double_round.v b/flocq/Appli/Fappli_double_round.v
index 3ff6c31a..2c4937ab 100644
--- a/flocq/Appli/Fappli_double_round.v
+++ b/flocq/Appli/Fappli_double_round.v
@@ -183,8 +183,8 @@ destruct (Req_dec x' 0) as [Zx'|Nzx'].
apply Rplus_le_compat_r.
apply (Rmult_le_reg_r (bpow (- ln_beta x))); [now apply bpow_gt_0|].
unfold ulp, canonic_exp; bpow_simplify.
- rewrite <- (Rinv_r 2) at 3; [|lra].
- rewrite Rmult_comm; apply Rmult_le_compat_r; [lra|].
+ apply Rmult_le_reg_l with (1 := Rlt_0_2).
+ replace (2 * (/ 2 * _)) with (bpow (fexp1 (ln_beta x) - ln_beta x)) by field.
apply Rle_trans with 1; [|lra].
change 1 with (bpow 0); apply bpow_le.
omega.
@@ -1037,10 +1037,11 @@ destruct Hexp as (_,(_,(_,Hexp4))).
assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
[now apply Hexp4; omega|].
assert (Bpow2 : bpow (- 2) <= / 2 * / 2).
-{ unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
- rewrite <- Rinv_mult_distr; [|lra|lra].
+{ replace (/2 * /2) with (/4) by field.
+ rewrite (bpow_opp _ 2).
apply Rinv_le; [lra|].
- change 4 with (Z2R (2 * 2)); apply Z2R_le; rewrite Zmult_1_r.
+ apply (Z2R_le (2 * 2) (beta * (beta * 1))).
+ rewrite Zmult_1_r.
now apply Zmult_le_compat; omega. }
assert (P2 : (0 < 2)%Z) by omega.
unfold double_round_eq.
@@ -1384,10 +1385,11 @@ assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
[now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (Bpow2 : bpow (- 2) <= / 2 * / 2).
-{ unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
- rewrite <- Rinv_mult_distr; [|lra|lra].
+{ replace (/2 * /2) with (/4) by field.
+ rewrite (bpow_opp _ 2).
apply Rinv_le; [lra|].
- change 4 with (Z2R (2 * 2)); apply Z2R_le; rewrite Zmult_1_r.
+ apply (Z2R_le (2 * 2) (beta * (beta * 1))).
+ rewrite Zmult_1_r.
now apply Zmult_le_compat; omega. }
assert (Ly : y < bpow (ln_beta y)).
{ apply Rabs_lt_inv.
@@ -1449,7 +1451,7 @@ apply double_round_gt_mid.
unfold canonic_exp.
apply (Rplus_le_reg_r (bpow (fexp2 (ln_beta (x - y))))); ring_simplify.
apply Rle_trans with (2 * bpow (fexp1 (ln_beta (x - y)) - 1)).
- * rewrite Rmult_plus_distr_r; rewrite Rmult_1_l.
+ * replace (2 * bpow (fexp1 (ln_beta (x - y)) - 1)) with (bpow (fexp1 (ln_beta (x - y)) - 1) + bpow (fexp1 (ln_beta (x - y)) - 1)) by ring.
apply Rplus_le_compat_l.
now apply bpow_le.
* unfold Zminus; rewrite bpow_plus.
@@ -1458,10 +1460,10 @@ apply double_round_gt_mid.
apply Rmult_le_compat_l; [now apply bpow_ge_0|].
unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
rewrite Zmult_1_r.
- rewrite <- (Rinv_r 2) at 3; [|lra].
- rewrite Rmult_comm; apply Rmult_le_compat_l; [lra|].
- apply Rinv_le; [lra|].
- now change 2 with (Z2R 2); apply Z2R_le.
+ apply Z2R_le, Rinv_le in Hbeta.
+ simpl in Hbeta.
+ lra.
+ apply Rlt_0_2.
Qed.
(* double_round_minus_aux{0,1,2} together *)
@@ -4220,7 +4222,7 @@ destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - fexp1 (ln_beta (x / y))
bpow_simplify.
rewrite (Rmult_comm _ y).
do 2 rewrite Rmult_assoc.
- change (Z2R _ * _) with x'.
+ change (Z2R (Zfloor _) * _) with x'.
change (bpow _) with u1.
apply (Rmult_lt_reg_l (/ 2)); [lra|].
rewrite Rmult_plus_distr_l.
diff --git a/flocq/Appli/Fappli_rnd_odd.v b/flocq/Appli/Fappli_rnd_odd.v
index 4741047f..b6d985ac 100644
--- a/flocq/Appli/Fappli_rnd_odd.v
+++ b/flocq/Appli/Fappli_rnd_odd.v
@@ -20,7 +20,7 @@ COPYING file for more details.
(** * Rounding to odd and its properties, including the equivalence
between rnd_NE and double rounding with rnd_odd and then rnd_NE *)
-
+Require Import Reals Psatz.
Require Import Fcore.
Require Import Fcalc_ops.
@@ -577,29 +577,23 @@ Qed.
Lemma d_le_m: (F2R d <= m)%R.
-apply Rmult_le_reg_l with 2%R.
-auto with real.
-apply Rplus_le_reg_l with (-F2R d)%R.
-apply Rle_trans with (F2R d).
-right; ring.
-apply Rle_trans with (F2R u).
-apply Rle_trans with x.
-apply Hd.
-apply Hu.
-right; unfold m; field.
+Proof.
+assert (F2R d <= F2R u)%R.
+ apply Rle_trans with x.
+ apply Hd.
+ apply Hu.
+unfold m.
+lra.
Qed.
Lemma m_le_u: (m <= F2R u)%R.
-apply Rmult_le_reg_l with 2%R.
-auto with real.
-apply Rplus_le_reg_l with (-F2R u)%R.
-apply Rle_trans with (F2R d).
-right; unfold m; field.
-apply Rle_trans with (F2R u).
-apply Rle_trans with x.
-apply Hd.
-apply Hu.
-right; ring.
+Proof.
+assert (F2R d <= F2R u)%R.
+ apply Rle_trans with x.
+ apply Hd.
+ apply Hu.
+unfold m.
+lra.
Qed.
Lemma ln_beta_m: (0 < F2R d)%R -> (ln_beta beta m =ln_beta beta (F2R d) :>Z).
@@ -641,20 +635,13 @@ now apply Rgt_not_eq.
now apply generic_format_canonic.
now left.
replace m with (F2R d).
-destruct (ln_beta beta (F2R d)) as (e,He).
+destruct (ln_beta beta (F2R d)) as (e,He).
simpl in *; rewrite Rabs_right in He.
apply He.
now apply Rgt_not_eq.
apply Rle_ge; now left.
-assert (F2R d = F2R u).
-apply Rmult_eq_reg_l with (/2)%R.
-apply Rplus_eq_reg_l with (/2*F2R u)%R.
-apply trans_eq with m.
-unfold m, Rdiv; ring.
-rewrite H; field.
-auto with real.
-apply Rgt_not_eq, Rlt_gt; auto with real.
-unfold m; rewrite <- H0; field.
+unfold m in H |- *.
+lra.
Qed.
@@ -666,7 +653,7 @@ apply ln_beta_unique_pos.
unfold m; rewrite <- Y, Rplus_0_l.
rewrite u_eq.
destruct (ln_beta beta x) as (e,He).
-rewrite Rabs_right in He.
+rewrite Rabs_pos_eq in He by now apply Rlt_le.
rewrite round_UP_small_pos with (ex:=e).
rewrite ln_beta_bpow.
ring_simplify (fexp e + 1 - 1)%Z.
@@ -676,7 +663,7 @@ unfold Rdiv; apply Rmult_le_compat_l.
apply bpow_ge_0.
simpl; unfold Z.pow_pos; simpl.
rewrite Zmult_1_r; apply Rinv_le.
-auto with real.
+exact Rlt_0_2.
apply (Z2R_le 2).
specialize (radix_gt_1 beta).
omega.
@@ -684,13 +671,11 @@ apply Rlt_le_trans with (bpow (fexp e)*1)%R.
2: right; ring.
unfold Rdiv; apply Rmult_lt_compat_l.
apply bpow_gt_0.
-rewrite <- Rinv_1 at 3.
-apply Rinv_lt; auto with real.
+lra.
now apply He, Rgt_not_eq.
apply exp_small_round_0_pos with beta (Zfloor) x...
now apply He, Rgt_not_eq.
now rewrite <- d_eq, Y.
-now left.
Qed.
@@ -723,9 +708,8 @@ unfold Rdiv; apply f_equal.
unfold F2R; simpl; unfold Z.pow_pos; simpl.
rewrite Zmult_1_r, Hb, Z2R_mult.
simpl; field.
-apply Rgt_not_eq, Rmult_lt_reg_l with (Z2R 2).
-simpl; auto with real.
-rewrite Rmult_0_r, <-Z2R_mult, <-Hb.
+apply Rgt_not_eq, Rmult_lt_reg_l with (1 := Rlt_0_2).
+rewrite Rmult_0_r, <- (Z2R_mult 2), <-Hb.
apply radix_pos.
apply trans_eq with (-1+Fexp (Fplus beta d u'))%Z.
unfold Fmult.
@@ -752,9 +736,8 @@ unfold Rdiv; apply f_equal.
unfold F2R; simpl; unfold Z.pow_pos; simpl.
rewrite Zmult_1_r, Hb, Z2R_mult.
simpl; field.
-apply Rgt_not_eq, Rmult_lt_reg_l with (Z2R 2).
-simpl; auto with real.
-rewrite Rmult_0_r, <-Z2R_mult, <-Hb.
+apply Rgt_not_eq, Rmult_lt_reg_l with (1 := Rlt_0_2).
+rewrite Rmult_0_r, <- (Z2R_mult 2), <-Hb.
apply radix_pos.
apply trans_eq with (-1+Fexp u)%Z.
unfold Fmult.
diff --git a/flocq/Core/Fcore_FLT.v b/flocq/Core/Fcore_FLT.v
index 372af6ad..53dc48a7 100644
--- a/flocq/Core/Fcore_FLT.v
+++ b/flocq/Core/Fcore_FLT.v
@@ -187,7 +187,7 @@ Qed.
(** Links between FLT and FIX (underflow) *)
Theorem canonic_exp_FLT_FIX :
- forall x, x <> R0 ->
+ forall x, x <> 0%R ->
(Rabs x < bpow (emin + prec))%R ->
canonic_exp beta FLT_exp x = canonic_exp beta (FIX_exp emin) x.
Proof.
diff --git a/flocq/Core/Fcore_FTZ.v b/flocq/Core/Fcore_FTZ.v
index 2ebc7851..a2fab00b 100644
--- a/flocq/Core/Fcore_FTZ.v
+++ b/flocq/Core/Fcore_FTZ.v
@@ -217,7 +217,7 @@ Variable rnd : R -> Z.
Context { valid_rnd : Valid_rnd rnd }.
Definition Zrnd_FTZ x :=
- if Rle_bool R1 (Rabs x) then rnd x else Z0.
+ if Rle_bool 1 (Rabs x) then rnd x else Z0.
Global Instance valid_rnd_FTZ : Valid_rnd Zrnd_FTZ.
Proof with auto with typeclass_instances.
@@ -270,7 +270,7 @@ Proof.
intros x Hx.
unfold round, scaled_mantissa, canonic_exp.
destruct (ln_beta beta x) as (ex, He). simpl.
-assert (Hx0: x <> R0).
+assert (Hx0: x <> 0%R).
intros Hx0.
apply Rle_not_lt with (1 := Hx).
rewrite Hx0, Rabs_R0.
@@ -286,7 +286,7 @@ rewrite Rle_bool_true.
apply refl_equal.
rewrite Rabs_mult.
rewrite (Rabs_pos_eq (bpow (- FLX_exp prec ex))).
-change R1 with (bpow 0).
+change 1%R with (bpow 0).
rewrite <- (Zplus_opp_r (FLX_exp prec ex)).
rewrite bpow_plus.
apply Rmult_le_compat_r.
@@ -320,7 +320,7 @@ rewrite Rle_bool_false.
apply F2R_0.
rewrite Rabs_mult.
rewrite (Rabs_pos_eq (bpow (- FTZ_exp ex))).
-change R1 with (bpow 0).
+change 1%R with (bpow 0).
rewrite <- (Zplus_opp_r (FTZ_exp ex)).
rewrite bpow_plus.
apply Rmult_lt_compat_r.
diff --git a/flocq/Core/Fcore_Raux.v b/flocq/Core/Fcore_Raux.v
index 939002cf..44db6c35 100644
--- a/flocq/Core/Fcore_Raux.v
+++ b/flocq/Core/Fcore_Raux.v
@@ -403,7 +403,7 @@ Definition Z2R n :=
match n with
| Zpos p => P2R p
| Zneg p => Ropp (P2R p)
- | Z0 => R0
+ | Z0 => 0%R
end.
Theorem P2R_INR :
@@ -432,10 +432,13 @@ Theorem Z2R_IZR :
forall n, Z2R n = IZR n.
Proof.
intro.
-case n ; intros ; simpl.
+case n ; intros ; unfold Z2R.
apply refl_equal.
+rewrite <- positive_nat_Z, <- INR_IZR_INZ.
apply P2R_INR.
+change (IZR (Zneg p)) with (Ropp (IZR (Zpos p))).
apply Ropp_eq_compat.
+rewrite <- positive_nat_Z, <- INR_IZR_INZ.
apply P2R_INR.
Qed.
@@ -1193,7 +1196,7 @@ unfold Ztrunc.
case Rlt_bool_spec ; intro H.
apply refl_equal.
rewrite (Rle_antisym _ _ Hx H).
-fold (Z2R 0).
+change 0%R with (Z2R 0).
rewrite Zceil_Z2R.
apply Zfloor_Z2R.
Qed.
@@ -1304,7 +1307,7 @@ unfold Zaway.
case Rlt_bool_spec ; intro H.
apply refl_equal.
rewrite (Rle_antisym _ _ Hx H).
-fold (Z2R 0).
+change 0%R with (Z2R 0).
rewrite Zfloor_Z2R.
apply Zceil_Z2R.
Qed.
@@ -1456,7 +1459,7 @@ Definition bpow e :=
match e with
| Zpos p => Z2R (Zpower_pos r p)
| Zneg p => Rinv (Z2R (Zpower_pos r p))
- | Z0 => R1
+ | Z0 => 1%R
end.
Theorem Z2R_Zpower_pos :
@@ -1532,13 +1535,13 @@ Qed.
Theorem bpow_opp :
forall e : Z, (bpow (-e) = /bpow e)%R.
Proof.
-intros e; destruct e.
-simpl; now rewrite Rinv_1.
-now replace (-Zpos p)%Z with (Zneg p) by reflexivity.
-replace (-Zneg p)%Z with (Zpos p) by reflexivity.
+intros [|p|p].
+apply eq_sym, Rinv_1.
+now change (-Zpos p)%Z with (Zneg p).
+change (-Zneg p)%Z with (Zpos p).
simpl; rewrite Rinv_involutive; trivial.
-generalize (bpow_gt_0 (Zpos p)).
-simpl; auto with real.
+apply Rgt_not_eq.
+apply (bpow_gt_0 (Zpos p)).
Qed.
Theorem Z2R_Zpower_nat :
@@ -1872,7 +1875,7 @@ apply bpow_ge_0.
Qed.
Theorem ln_beta_mult_bpow :
- forall x e, x <> R0 ->
+ forall x e, x <> 0%R ->
(ln_beta (x * bpow e) = ln_beta x + e :>Z)%Z.
Proof.
intros x e Zx.
@@ -1895,7 +1898,7 @@ Qed.
Theorem ln_beta_le_bpow :
forall x e,
- x <> R0 ->
+ x <> 0%R ->
(Rabs x < bpow e)%R ->
(ln_beta x <= e)%Z.
Proof.
@@ -2044,20 +2047,19 @@ destruct Hex as (Hex0,Hex1); [now apply Rgt_not_eq|].
assert (Haxy : (Rabs (x + y) < bpow (ex + 1))%R).
{ rewrite bpow_plus1.
apply Rlt_le_trans with (2 * bpow ex)%R.
- - apply Rle_lt_trans with (2 * Rabs x)%R.
- + rewrite Rabs_right.
- { apply Rle_trans with (x + x)%R; [now apply Rplus_le_compat_l|].
- rewrite Rabs_right.
- { rewrite Rmult_plus_distr_r.
- rewrite Rmult_1_l.
- now apply Rle_refl. }
- now apply Rgt_ge. }
- apply Rgt_ge.
- rewrite <- (Rplus_0_l 0).
- now apply Rplus_gt_compat.
- + now apply Rmult_lt_compat_l; intuition.
- - apply Rmult_le_compat_r; [now apply bpow_ge_0|].
- now change 2%R with (Z2R 2); apply Z2R_le. }
+ - rewrite Rabs_pos_eq.
+ apply Rle_lt_trans with (2 * Rabs x)%R.
+ + rewrite Rabs_pos_eq.
+ replace (2 * x)%R with (x + x)%R by ring.
+ now apply Rplus_le_compat_l.
+ now apply Rlt_le.
+ + apply Rmult_lt_compat_l with (2 := Hex1).
+ exact Rlt_0_2.
+ + rewrite <- (Rplus_0_l 0).
+ now apply Rlt_le, Rplus_lt_compat.
+ - apply Rmult_le_compat_r.
+ now apply bpow_ge_0.
+ now apply (Z2R_le 2). }
assert (Haxy2 : (bpow (ex - 1) <= Rabs (x + y))%R).
{ apply (Rle_trans _ _ _ Hex0).
rewrite Rabs_right; [|now apply Rgt_ge].
diff --git a/flocq/Core/Fcore_float_prop.v b/flocq/Core/Fcore_float_prop.v
index 8199ede6..a183bf0a 100644
--- a/flocq/Core/Fcore_float_prop.v
+++ b/flocq/Core/Fcore_float_prop.v
@@ -136,7 +136,7 @@ Qed.
(** Sign facts *)
Theorem F2R_0 :
forall e : Z,
- F2R (Float beta 0 e) = R0.
+ F2R (Float beta 0 e) = 0%R.
Proof.
intros e.
unfold F2R. simpl.
@@ -145,7 +145,7 @@ Qed.
Theorem F2R_eq_0_reg :
forall m e : Z,
- F2R (Float beta m e) = R0 ->
+ F2R (Float beta m e) = 0%R ->
m = Z0.
Proof.
intros m e H.
diff --git a/flocq/Core/Fcore_generic_fmt.v b/flocq/Core/Fcore_generic_fmt.v
index 21e51890..668b4da2 100644
--- a/flocq/Core/Fcore_generic_fmt.v
+++ b/flocq/Core/Fcore_generic_fmt.v
@@ -252,7 +252,7 @@ apply Rmult_1_r.
Qed.
Theorem scaled_mantissa_0 :
- scaled_mantissa 0 = R0.
+ scaled_mantissa 0 = 0%R.
Proof.
apply Rmult_0_l.
Qed.
@@ -667,7 +667,7 @@ Theorem round_bounded_small_pos :
forall x ex,
(ex <= fexp ex)%Z ->
(bpow (ex - 1) <= x < bpow ex)%R ->
- round x = R0 \/ round x = bpow (fexp ex).
+ round x = 0%R \/ round x = bpow (fexp ex).
Proof.
intros x ex He Hx.
unfold round, scaled_mantissa.
@@ -751,19 +751,19 @@ now apply sym_eq.
Qed.
Theorem round_0 :
- round 0 = R0.
+ round 0 = 0%R.
Proof.
unfold round, scaled_mantissa.
rewrite Rmult_0_l.
-fold (Z2R 0).
+change 0%R with (Z2R 0).
rewrite Zrnd_Z2R.
apply F2R_0.
Qed.
Theorem exp_small_round_0_pos :
forall x ex,
- (bpow (ex - 1) <= x < bpow ex)%R ->
- round x =R0 -> (ex <= fexp ex)%Z .
+ (bpow (ex - 1) <= x < bpow ex)%R ->
+ round x = 0%R -> (ex <= fexp ex)%Z .
Proof.
intros x ex H H1.
case (Zle_or_lt ex (fexp ex)); trivial; intros V.
@@ -771,7 +771,7 @@ contradict H1.
apply Rgt_not_eq.
apply Rlt_le_trans with (bpow (ex-1)).
apply bpow_gt_0.
-apply (round_bounded_large_pos); assumption.
+apply (round_bounded_large_pos); assumption.
Qed.
Theorem generic_format_round_pos :
@@ -931,7 +931,7 @@ rewrite <- Ropp_0.
now apply Ropp_lt_contravar.
now apply Ropp_le_contravar.
(* . 0 <= y *)
-apply Rle_trans with R0.
+apply Rle_trans with 0%R.
apply F2R_le_0_compat. simpl.
rewrite <- (Zrnd_Z2R rnd 0).
apply Zrnd_le...
@@ -1020,7 +1020,7 @@ Qed.
Theorem exp_small_round_0 :
forall rnd {Hr : Valid_rnd rnd} x ex,
(bpow (ex - 1) <= Rabs x < bpow ex)%R ->
- round rnd x =R0 -> (ex <= fexp ex)%Z .
+ round rnd x = 0%R -> (ex <= fexp ex)%Z .
Proof.
intros rnd Hr x ex H1 H2.
generalize Rabs_R0.
@@ -1177,7 +1177,7 @@ rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
apply Rmult_le_compat_r with (2 := Hx).
apply bpow_ge_0.
rewrite <- H.
-change R0 with (Z2R 0).
+change 0%R with (Z2R 0).
now rewrite Zfloor_Z2R, Zceil_Z2R.
Qed.
@@ -1212,7 +1212,7 @@ rewrite <- (Rmult_0_l (bpow (- canonic_exp x))).
apply Rmult_le_compat_r with (2 := Hx).
apply bpow_ge_0.
rewrite <- H.
-change R0 with (Z2R 0).
+change 0%R with (Z2R 0).
now rewrite Zfloor_Z2R, Zceil_Z2R.
Qed.
@@ -1296,7 +1296,7 @@ Theorem round_DN_small_pos :
forall x ex,
(bpow (ex - 1) <= x < bpow ex)%R ->
(ex <= fexp ex)%Z ->
- round Zfloor x = R0.
+ round Zfloor x = 0%R.
Proof.
intros x ex Hx He.
rewrite <- (F2R_0 beta (canonic_exp x)).
@@ -1552,7 +1552,7 @@ Qed.
Lemma canonic_exp_le_bpow :
forall (x : R) (e : Z),
- x <> R0 ->
+ x <> 0%R ->
(Rabs x < bpow e)%R ->
(canonic_exp x <= fexp e)%Z.
Proof.
@@ -1578,7 +1578,7 @@ Context { valid_rnd : Valid_rnd rnd }.
Theorem ln_beta_round_ge :
forall x,
- round rnd x <> R0 ->
+ round rnd x <> 0%R ->
(ln_beta beta x <= ln_beta beta (round rnd x))%Z.
Proof with auto with typeclass_instances.
intros x.
@@ -1597,7 +1597,7 @@ Qed.
Theorem canonic_exp_round_ge :
forall x,
- round rnd x <> R0 ->
+ round rnd x <> 0%R ->
(canonic_exp x <= canonic_exp (round rnd x))%Z.
Proof with auto with typeclass_instances.
intros x Zr.
@@ -1807,7 +1807,7 @@ rewrite Zceil_floor_neq.
rewrite Z2R_plus.
simpl.
apply Ropp_lt_cancel.
-apply Rplus_lt_reg_l with R1.
+apply Rplus_lt_reg_l with 1%R.
replace (1 + -/2)%R with (/2)%R by field.
now replace (1 + - (Z2R (Zfloor x) + 1 - x))%R with (x - Z2R (Zfloor x))%R by ring.
apply Rlt_not_eq.
@@ -1866,7 +1866,7 @@ rewrite Z2R_abs, Z2R_minus.
replace (Z2R (Znearest x) - Z2R n)%R with (- (x - Z2R (Znearest x)) + (x - Z2R n))%R by ring.
apply Rle_lt_trans with (1 := Rabs_triang _ _).
simpl.
-replace R1 with (/2 + /2)%R by field.
+replace 1%R with (/2 + /2)%R by field.
apply Rplus_le_lt_compat with (2 := Hd).
rewrite Rabs_Ropp.
apply Znearest_N.
diff --git a/flocq/Core/Fcore_rnd_ne.v b/flocq/Core/Fcore_rnd_ne.v
index 1f265406..2d67e709 100644
--- a/flocq/Core/Fcore_rnd_ne.v
+++ b/flocq/Core/Fcore_rnd_ne.v
@@ -370,7 +370,7 @@ destruct (Rle_or_lt (round beta fexp Zfloor x) 0) as [Hr|Hr].
rewrite (Rle_antisym _ _ Hr).
unfold scaled_mantissa.
rewrite Rmult_0_l.
-change R0 with (Z2R 0).
+change 0%R with (Z2R 0).
now rewrite (Ztrunc_Z2R 0).
rewrite <- (round_0 beta fexp Zfloor).
apply round_le...
diff --git a/flocq/Core/Fcore_ulp.v b/flocq/Core/Fcore_ulp.v
index 28d2bc35..3bc0eac3 100644
--- a/flocq/Core/Fcore_ulp.v
+++ b/flocq/Core/Fcore_ulp.v
@@ -18,6 +18,7 @@ COPYING file for more details.
*)
(** * Unit in the Last Place: our definition using fexp and its properties, successor and predecessor *)
+Require Import Reals Psatz.
Require Import Fcore_Raux.
Require Import Fcore_defs.
Require Import Fcore_rnd.
@@ -2002,7 +2003,7 @@ rewrite Hx in Hfx; contradict Hfx; auto with real.
intros H.
apply Rle_trans with (1:=error_le_half_ulp _ _).
apply Rmult_le_compat_l.
-auto with real.
+apply Rlt_le, pos_half_prf.
apply ulp_le.
rewrite Hx; rewrite (Rabs_left1 x), Rabs_left; try assumption.
apply Ropp_le_contravar.
@@ -2018,7 +2019,7 @@ case (Rle_or_lt 0 (round beta fexp Zceil x)).
intros H; destruct H.
apply Rle_trans with (1:=error_le_half_ulp _ _).
apply Rmult_le_compat_l.
-auto with real.
+apply Rlt_le, pos_half_prf.
apply ulp_le_pos; trivial.
case (Rle_or_lt 0 x); trivial.
intros H1; contradict H.
@@ -2234,21 +2235,7 @@ apply generic_format_0.
left; apply Rlt_le_trans with (1:=H).
rewrite V1,V2; right; field.
(* *)
-assert (T: (u < (u + succ u) / 2 < succ u)%R).
-split.
-apply Rmult_lt_reg_l with 2%R.
-now auto with real.
-apply Rplus_lt_reg_l with (-u)%R.
-apply Rle_lt_trans with u;[right; ring|idtac].
-apply Rlt_le_trans with (1:=V).
-right; field.
-apply Rmult_lt_reg_l with 2%R.
-now auto with real.
-apply Rplus_lt_reg_l with (-succ u)%R.
-apply Rle_lt_trans with u;[right; field|idtac].
-apply Rlt_le_trans with (1:=V).
-right; ring.
-(* *)
+assert (T: (u < (u + succ u) / 2 < succ u)%R) by lra.
destruct T as (T1,T2).
apply Rnd_N_pt_monotone with F v ((u + succ u) / 2)%R...
apply round_N_pt...
diff --git a/flocq/Prop/Fprop_Sterbenz.v b/flocq/Prop/Fprop_Sterbenz.v
index 7260d2e1..4e74f889 100644
--- a/flocq/Prop/Fprop_Sterbenz.v
+++ b/flocq/Prop/Fprop_Sterbenz.v
@@ -133,7 +133,7 @@ assert (Hy0: (0 <= y)%R).
apply Rplus_le_reg_r with y.
apply Rle_trans with x.
now rewrite Rplus_0_l.
-now rewrite Rmult_plus_distr_r, Rmult_1_l in Hxy2.
+now replace (y + y)%R with (2 * y)%R by ring.
rewrite Rabs_pos_eq with (1 := Hy0).
rewrite Rabs_pos_eq.
unfold Rmin.
diff --git a/flocq/Prop/Fprop_div_sqrt_error.v b/flocq/Prop/Fprop_div_sqrt_error.v
index 9d29001d..422b6b64 100644
--- a/flocq/Prop/Fprop_div_sqrt_error.v
+++ b/flocq/Prop/Fprop_div_sqrt_error.v
@@ -103,7 +103,7 @@ apply Rlt_le_trans with (Rabs x * 1)%R.
apply Rmult_lt_compat_l.
now apply Rabs_pos_lt.
apply Rlt_le_trans with (1 := Heps1).
-change R1 with (bpow 0).
+change 1%R with (bpow 0).
apply bpow_le.
generalize (prec_gt_0 prec).
clear ; omega.
@@ -191,7 +191,7 @@ apply Rsqr_le_abs_1.
apply Rle_trans with (1 := Rabs_triang _ _).
rewrite Rabs_R1.
apply Rplus_le_reg_l with (-1)%R.
-rewrite <- Rplus_assoc, Rplus_opp_l, Rplus_0_l.
+replace (-1 + (1 + Rabs eps))%R with (Rabs eps) by ring.
apply Rle_trans with (1 := Heps1).
rewrite Rabs_pos_eq.
apply Rmult_le_reg_l with 2%R.
@@ -256,8 +256,7 @@ replace (prec+(Fexp fr+Fexp fr))%Z with (Fexp fr + (prec+Fexp fr))%Z by ring.
rewrite bpow_plus, Rmult_assoc.
apply Rmult_lt_compat_l.
apply bpow_gt_0.
-apply Rmult_lt_reg_l with 2%R.
-auto with real.
+apply Rmult_lt_reg_l with (1 := Rlt_0_2).
apply Rle_lt_trans with (Rabs (F2R fr + sqrt x)).
right; field.
apply Rle_lt_trans with (1:=Rabs_triang _ _).
@@ -273,7 +272,7 @@ rewrite <- Hr1; auto.
apply Rlt_le_trans with (bpow (prec + Fexp fr)+ Rabs (sqrt x))%R.
now apply Rplus_lt_compat_r.
(* . *)
-rewrite Rmult_plus_distr_r, Rmult_1_l.
+replace (2 * bpow (prec + Fexp fr))%R with (bpow (prec + Fexp fr) + bpow (prec + Fexp fr))%R by ring.
apply Rplus_le_compat_l.
assert (sqrt x <> 0)%R.
apply Rgt_not_eq.
diff --git a/flocq/Prop/Fprop_plus_error.v b/flocq/Prop/Fprop_plus_error.v
index 950ca267..41c2f031 100644
--- a/flocq/Prop/Fprop_plus_error.v
+++ b/flocq/Prop/Fprop_plus_error.v
@@ -157,7 +157,7 @@ Lemma round_plus_eq_zero_aux :
(canonic_exp beta fexp x <= canonic_exp beta fexp y)%Z ->
format x -> format y ->
(0 <= x + y)%R ->
- round beta fexp rnd (x + y) = R0 ->
+ round beta fexp rnd (x + y) = 0%R ->
(x + y = 0)%R.
Proof with auto with typeclass_instances.
intros x y He Hx Hy Hp Hxy.
@@ -202,11 +202,11 @@ Context { valid_rnd : Valid_rnd rnd }.
Theorem round_plus_eq_zero :
forall x y,
format x -> format y ->
- round beta fexp rnd (x + y) = R0 ->
+ round beta fexp rnd (x + y) = 0%R ->
(x + y = 0)%R.
Proof with auto with typeclass_instances.
intros x y Hx Hy.
-destruct (Rle_or_lt R0 (x + y)) as [H1|H1].
+destruct (Rle_or_lt 0 (x + y)) as [H1|H1].
(* . *)
revert H1.
destruct (Zle_or_lt (canonic_exp beta fexp x) (canonic_exp beta fexp y)) as [H2|H2].
diff --git a/flocq/Prop/Fprop_relative.v b/flocq/Prop/Fprop_relative.v
index 585b71da..276ccd3b 100644
--- a/flocq/Prop/Fprop_relative.v
+++ b/flocq/Prop/Fprop_relative.v
@@ -44,7 +44,7 @@ Proof with auto with typeclass_instances.
intros x b Hb0 Hxb.
destruct (Req_dec x 0) as [Hx0|Hx0].
(* *)
-exists R0.
+exists 0%R.
split.
now rewrite Rabs_R0.
rewrite Hx0, Rmult_0_l.
@@ -71,7 +71,7 @@ Proof with auto with typeclass_instances.
intros x b Hb0 Hxb.
destruct (Req_dec x 0) as [Hx0|Hx0].
(* *)
-exists R0.
+exists 0%R.
split.
now rewrite Rabs_R0.
rewrite Hx0, Rmult_0_l.
@@ -588,7 +588,7 @@ rewrite Rabs_right;[assumption|apply Rle_ge; now left].
exists eps; exists 0%R.
split;[assumption|split].
rewrite Rabs_R0; apply Rmult_le_pos.
-auto with real.
+apply Rlt_le, pos_half_prf.
apply bpow_ge_0.
split;[apply Rmult_0_r|idtac].
now rewrite Rplus_0_r.
@@ -596,13 +596,14 @@ now rewrite Rplus_0_r.
exists 0%R; exists (round beta (FLT_exp emin prec) (Znearest choice) x - x)%R.
split.
rewrite Rabs_R0; apply Rmult_le_pos.
-auto with real.
+apply Rlt_le, pos_half_prf.
apply bpow_ge_0.
split.
apply Rle_trans with (/2*ulp beta (FLT_exp emin prec) x)%R.
apply error_le_half_ulp.
now apply FLT_exp_valid.
-apply Rmult_le_compat_l; auto with real.
+apply Rmult_le_compat_l.
+apply Rlt_le, pos_half_prf.
rewrite ulp_neq_0.
2: now apply Rgt_not_eq.
apply bpow_le.
@@ -650,7 +651,7 @@ destruct (Rtotal_order x 0) as [Nx|[Zx|Px]].
{ apply (Rmult_le_reg_l 2 _ _ Rlt_0_2).
rewrite Rmult_0_r, Rinv_r; [exact Rle_0_1|].
apply Rgt_not_eq, Rlt_gt, Rlt_0_2. }
- exists R0; exists R0; rewrite Zx; split; [|split; [|split]].
+ exists 0%R; exists 0%R; rewrite Zx; split; [|split; [|split]].
{ now rewrite Rabs_R0; apply Rmult_le_pos; [|apply bpow_ge_0]. }
{ now rewrite Rabs_R0; apply Rmult_le_pos; [|apply bpow_ge_0]. }
{ now rewrite Rmult_0_l. }