intros x y p H H0 H1 H2 H3.
cut (0 < 2%nat * pPred (vNum b))%Z;
[ intros NZ1 | apply Zlt_trans with radix; auto with zarith ].
cut (0 < 2%nat * pPred (vNum b))%R;
[ intros NZ1'
| rewrite INR_IZR_INZ; rewrite <- Rmult_IZR; auto with real zarith ].
cut (radix < 2%nat * pPred (vNum b))%R;
[ intros NZ2
| rewrite INR_IZR_INZ; rewrite <- Rmult_IZR; auto with real zarith ].
replace (Rabs p) with
(Rabs p * ((2%nat * pPred (vNum b) - radix) * / (2%nat * pPred (vNum b))) *
(2%nat * pPred (vNum b) * / (2%nat * pPred (vNum b) - radix)))%R.
2: replace
(Rabs p * ((2%nat * pPred (vNum b) - radix) * / (2%nat * pPred (vNum b))) *
(2%nat * pPred (vNum b) * / (2%nat * pPred (vNum b) - radix)))%R with
(Rabs p *
((2%nat * pPred (vNum b) - radix) * / (2%nat * pPred (vNum b) - radix)) *
(2%nat * pPred (vNum b) * / (2%nat * pPred (vNum b))))%R;
[ idtac | ring ].
2: repeat rewrite Rinv_r; auto with real zarith; try ring.
apply Rmult_le_compat_r.
replace 0%R with (2%nat * pPred (vNum b) * 0)%R;
[ apply Rmult_le_compat_l | ring ]; auto with real zarith.
replace ((2%nat * pPred (vNum b) - radix) * / (2%nat * pPred (vNum b)))%R
with (1 - radix * / (2%nat * pPred (vNum b)))%R.
2: unfold Rminus in |- *; rewrite Rmult_plus_distr_r; rewrite Rinv_r;
auto with real.
replace (Rabs p * (1 - radix * / (2%nat * pPred (vNum b))))%R with
(Rabs p - Rabs p * (radix * / (2%nat * pPred (vNum b))))%R;
[ idtac | ring; ring ].
apply Rplus_le_reg_l with (Rabs p * (radix * / (2%nat * pPred (vNum b))))%R.
replace
(Rabs (FtoRradix p) * (radix * / (2%nat * pPred (vNum b))) +
(Rabs (FtoRradix p) -
Rabs (FtoRradix p) * (radix * / (2%nat * pPred (vNum b)))))%R with
(Rabs p); [ idtac | ring ].
apply Rle_trans with (Rabs (p - (x + y)) + Rabs (x + y))%R.
pattern (FtoRradix p) at 1 in |- *;
replace (FtoRradix p) with (p - (x + y) + (x + y))%R;
[ apply Rabs_triang | ring ].
rewrite (Rplus_comm (Rabs (p - (x + y))) (Rabs (x + y)));
rewrite
(Rplus_comm (Rabs p * (radix * / (2%nat * pPred (vNum b)))) (Rabs (x + y)))
; apply Rplus_le_compat_l.
replace (Rabs p * (radix * / (2%nat * pPred (vNum b))))%R with
(Rabs p * / 2%nat * (radix * / pPred (vNum b)))%R;
[ apply plusErrorBound1withZero | idtac ]; auto.
rewrite (Rinv_mult_distr 2%nat (pPred (vNum b))); auto with real zarith.
ring.
apply NEq_IZRO; auto with real zarith.
generalize pPredMoreThanOne; auto with zarith.
Qed.

(* Specifications: *)
Theorem plusExactExp :
forall p q pq : float,
Fbounded b p ->
Fbounded b q ->
Closest b radix (p + q) pq ->
ex
(fun r : float =>
ex
(fun s : float =>
Fbounded b r /\
Fbounded b s /\
s = pq :>R /\
r = (p + q - s)%R :>R /\
Fexp r = Zmin (Fexp p) (Fexp q) :>Z /\
(Fexp r <= Fexp s)%Z /\ (Fexp s <= Zsucc (Zmax (Fexp p) (Fexp q)))%Z)).