Section FRoundP.
Variable b : Fbound.
Variable radix : Z.
Variable precision : nat.
Let FtoRradix := FtoR radix.
Local Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.
intros p r H' H'0.
case ClosestMinOrMax with (1 := H'); intros H'3.
apply Rle_trans with r; auto with real.
apply isMin_inv1 with (1 := H'3).
case (MinEx b radix precision) with (r := r); auto with arith.
intros min Hmin.
apply Rle_trans with (min + p)%R; auto with real.
apply Rplus_le_reg_l with (r := (- p)%R).
replace (- p + p)%R with 0%R; [ idtac | ring ].
replace (- p + (min + p))%R with (FtoRradix min);
[ apply (RleMinR0 b radix precision) with (r := r); auto | ring ].
apply Rplus_le_reg_l with (r := (- r)%R).
apply Rplus_le_reg_l with (r := (- min)%R).
replace (- min + (- r + (min + p)))%R with (Rabs (p - r)).
replace (- min + (- r + 2%nat * r))%R with (Rabs (min - r)).
case H'.
intros H'1 H'2; apply H'2; auto.
case Hmin; auto.
rewrite Faux.Rabsolu_left1; simpl in |- *.
ring; auto.
apply Rle_minus; apply isMin_inv1 with (1 := Hmin).
rewrite Rabs_right; simpl in |- *.
ring; auto.
apply Rle_ge; apply Rplus_le_reg_l with (r := r).
replace (r + 0)%R with r; [ idtac | ring ].
replace (r + (p - r))%R with (FtoRradix p);
[ apply isMax_inv1 with (1 := H'3) | ring ].
Qed.
intros p r H' H'0.
replace (2%nat * r)%R with (- (2%nat * - r))%R; [ idtac | ring ].
replace (FtoRradix p) with (- - p)%R;
[ unfold FtoRradix in |- *; rewrite <- Fopp_correct | ring ].
apply Ropp_le_contravar.
apply closestLessMultPos; auto.
apply ClosestOpp; auto.
replace 0%R with (-0)%R; [ auto with real | ring ].
Qed.
intros p r H'; case (Rle_or_lt 0 r); intros H'1.
repeat rewrite Rabs_right; auto with real.
apply closestLessMultPos; auto.
apply Rle_ge;
apply (RleRoundedR0 b radix precision) with (P := Closest b radix) (r := r);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
repeat rewrite Faux.Rabsolu_left1; auto.
replace (2%nat * - r)%R with (- (2%nat * r))%R;
[ apply Ropp_le_contravar | ring ].
apply closestLessMultNeg; auto.
apply Rlt_le; auto.
apply Rlt_le; auto.
apply
(RleRoundedLessR0 b radix precision) with (P := Closest b radix) (r := r);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply Rlt_le; auto.
Qed.
intros p q pq Hp Hq H1 H2 H3.
cut (RoundedModeP b radix (Closest b radix));
[ intros H4 | apply ClosestRoundedModeP with precision; auto ].
lapply (errorBoundedMultExp b radix precision);
[ intros H'2; lapply H'2;
[ intros H'3; lapply H'3;
[ intros H'4; lapply (H'4 (Closest b radix));
[ intros H'7; elim (H'7 p q pq);
[ intros r E; elim E; intros s E0; elim E0; intros H'15 H'16;
elim H'16; intros H'17 H'18; elim H'18;
intros H'19 H'20; elim H'20; intros H'21 H'22;
elim H'22; intros H'23 H'24; elim H'24;
intros H'25 H'26;
clear H'24 H'22 H'20 H'18 H'16 E0 E H'3 H'2
| clear  H'3 H'2
| clear  H'3 H'2
| clear  H'3 H'2
| clear  H'3 H'2 ]
| clear H'3 H'2 ]
| clear H'3 H'2 ]
| clear H'2 ]
| idtac]; auto.
exists (Fnormalize radix b precision r); exists s.
cut (Fbounded b (Fnormalize radix b precision r));
[ intros H5 | apply FnormalizeBounded; auto with arith ].
split; [ apply FnormalizeCanonic; auto with arith | idtac ].
repeat (split; auto).
unfold FtoRradix in |- *; rewrite <- H'19; unfold FtoRradix in |- *;
apply FnormalizeCorrect; auto.
unfold FtoRradix in |- *; rewrite FnormalizeCorrect; auto with arith.
apply Zlt_le_weak.
apply
RoundedModeErrorExpStrict with b radix precision (Closest b radix) (p * q)%R;
auto with arith.
generalize ClosestCompatible; unfold CompatibleP in |- *; intros H6.
generalize
(H6 b radix (FtoRradix p * FtoRradix q)%R (FtoRradix p * FtoRradix q)%R pq);
intros H9; apply H9; auto.
rewrite FnormalizeCorrect; auto with real arith.
rewrite FnormalizeCorrect; auto with real arith.
rewrite H'21; rewrite H'19; auto.
apply Z.le_trans with (Fexp r); auto.
apply FcanonicLeastExp with radix b precision; auto with arith.
rewrite FnormalizeCorrect; auto with real arith.
apply FnormalizeCanonic; auto with arith.
Qed.

Theorem errorBoundedMultClosest :
forall p q pq : float,
Fbounded b p ->
Fbounded b q ->
Closest b radix (p * q) pq ->
(- dExp b <= Fexp p + Fexp q)%Z ->
(- dExp b <= Fexp (Fnormalize radix b precision pq) - precision)%Z ->
ex
(fun r : float =>
ex
(fun s : float =>
Fcanonic radix b r /\
Fbounded b r /\
Fbounded b s /\
r = pq :>R /\
s = (p * q - r)%R :>R /\ Fexp s = (Fexp r - precision)%Z :>Z)).