intros p q r H' H'0 H'1 H'2.
cut (Fcanonic radix b (Fnormalize radix b precision r));
[ intros tmp; Casec tmp; intros Fs | idtac ].
3: apply FnormalizeCanonic; auto with arith.
3: apply
RoundedModeBounded
with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
auto.
3: apply ClosestRoundedModeP with (precision := precision); auto.
2: rewrite <- (plusExact1 p q (Fnormalize radix b precision r)); auto.
2: unfold FtoRradix in |- *; rewrite FnormalizeCorrect; auto.
2: replace (FtoR radix r - FtoR radix r)%R with 0%R; [ idtac | ring ].
2: rewrite Rabs_R0.
2: replace 0%R with (0 * (radix * / Zpos (vNum b)))%R;
[ apply Rmult_le_compat_r | ring ]; auto with real zarith.
2: replace 0%R with (0 * / Zpos (vNum b))%R;
[ apply Rmult_le_compat_r | ring ]; auto with real zarith.
2: replace 0%R with (0 * / 2%nat)%R; [ apply Rmult_le_compat_r | ring ];
auto with real zarith.
2: apply (ClosestCompatible b radix (p + q)%R (p + q)%R r); auto.
2: apply sym_eq; apply FnormalizeCorrect; auto.
2: apply FnormalizeBounded; auto with arith.
2: apply
RoundedModeBounded
with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
auto.
2: apply ClosestRoundedModeP with (precision := precision); auto.
2: replace (Fexp (Fnormalize radix b precision r)) with (- dExp b)%Z.
2: unfold Zmin in |- *; case (Fexp p ?= Fexp q)%Z; intuition.
2: case Fs; intros H1 (H2, H3); auto.
apply Rle_trans with (/ 2%nat * Fulp b radix precision r)%R.
replace (Rabs (FtoRradix r - (FtoRradix p + FtoRradix q))) with
(/ 2%nat * (2%nat * Rabs (FtoRradix r - (FtoRradix p + FtoRradix q))))%R;
[ idtac | rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real ].
apply Rmult_le_compat_l; auto with real.
replace (FtoRradix r - (FtoRradix p + FtoRradix q))%R with
(- (FtoRradix p + FtoRradix q - FtoRradix r))%R;
[ rewrite Rabs_Ropp | ring ].
apply (ClosestUlp b radix); auto.
replace (Rabs r * / 2%nat * (radix * / Zpos (vNum b)))%R with
(/ 2%nat * (Rabs r * (radix * / Zpos (vNum b))))%R;
[ apply Rmult_le_compat_l; auto with real | ring ].
replace (Fulp b radix precision r) with
(Zpos (vNum b) *
FtoR radix (Float 1%nat (Zpred (Fexp (Fnormalize radix b precision r)))) *
(radix * / Zpos (vNum b)))%R.
apply Rmult_le_compat_r.
replace 0%R with (radix * 0)%R; [ apply Rmult_le_compat_l | ring ];
apply Rlt_le; auto with real arith;
rewrite INR_IZR_INZ; apply Rlt_IZR; simpl in |- *; apply Zlt_1_O;
apply Zlt_le_weak;
apply (vNumbMoreThanOne radix) with (precision := precision);
auto with zarith.
unfold FtoRradix in |- *;
rewrite <- (FnormalizeCorrect _ radixMoreThanOne b precision r).
rewrite <- (Fabs_correct radix); auto with arith.
apply FnormalBoundAbs2 with precision; auto with arith.
unfold Fulp, FtoRradix, FtoR in |- *; simpl in |- *.
apply
trans_eq
with
(nat_of_P (vNum b) * / nat_of_P (vNum b) *
(radix * powerRZ radix (Zpred (Fexp (Fnormalize radix b precision r)))))%R;
[ unfold IZR at 1 5; repeat rewrite <- INR_IPR; ring | idtac].
rewrite Rinv_r; auto with real arith.
rewrite <- powerRZ_Zs; auto with real zarith.
rewrite <- Zsucc_pred; ring.
Qed.

(* Specifications: *)
Theorem plusErrorBound1withZero :
forall p q r : float,
Fbounded b p ->
Fbounded b q ->
Closest b radix (p + q) r ->
(Rabs (r - (p + q)) <= Rabs r * / 2%nat * (radix * / pPred (vNum b)))%R.