intros p q fmin Fp Fq H' H'0 H'1 H'2.
cut (0 <= Fnum p * Fnum q)%Z;
[ intros multPos
| apply Zle_mult_gen; apply (LeR0Fnum radix); auto with arith ].
cut (ex (fun m : Z => FtoRradix fmin = Float m (Fexp (Fmult p q)))).
2: unfold FtoRradix in |- *;
apply
RoundedModeRep
with (b := b) (precision := precision) (P := isMin b radix);
auto.
2: apply MinRoundedModeP with (precision := precision); auto.
2: rewrite (Fmult_correct radix); auto with zarith.
intros H'3; elim H'3; intros m E; clear H'3.
exists (Fminus radix (Fmult p q) (Float m (Fexp (Fmult p q)))).
split.
rewrite E; unfold FtoRradix in |- *; repeat rewrite Fminus_correct;
repeat rewrite Fmult_correct; auto with zarith.
split.
cut (fmin <= Fmult p q)%R;
[ idtac
| unfold FtoRradix in |- *; rewrite Fmult_correct; auto; case H'2;
auto with real zarith; (intros H1 H2; case H2; auto with zarith) ].
rewrite E; unfold Fmult, Fminus, Fopp, Fplus in |- *; simpl in |- *; auto.
repeat rewrite Zmin_n_n; repeat rewrite <- Zminus_diag_reverse; auto.
simpl in |- *; repeat rewrite Zpower_nat_O; repeat rewrite Zmult_1_r.
unfold FtoRradix, FtoR in |- *; simpl in |- *.
intros H'3;
(cut (m <= Fnum p * Fnum q)%Z;
[ idtac
| apply le_IZR;
apply Rmult_le_reg_l with (r := powerRZ radix (Fexp p + Fexp q));
auto with real zarith;
repeat rewrite (Rmult_comm (powerRZ radix (Fexp p + Fexp q)));
auto with zarith ]); intros H'4.
repeat split; simpl in |- *; auto.
case (ZquotientProp (Fnum p * Fnum q) (Zpower_nat radix precision));
auto with zarith.
intros x (H'5, (H'6, H'7)).
cut
(Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) *
powerRZ radix (precision + (Fexp p + Fexp q)) <= fmin)%R;
[ rewrite E; intros H'8 | idtac ].
cut
(Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) *
powerRZ radix precision <= m)%R; [ intros H'9 | idtac ].
rewrite Zabs_eq; auto with zarith.
apply Zle_lt_trans with x; auto.
replace x with
(Fnum p * Fnum q +
-
(Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) *
Zpower_nat radix precision))%Z.
apply Zplus_le_compat_l; auto.
apply Zle_Zopp.
apply le_IZR; auto.
rewrite Rmult_IZR.
rewrite Zpower_nat_Z_powerRZ; auto with zarith.
pattern (Fnum p * Fnum q)%Z at 1 in |- *; rewrite H'5; ring.
rewrite pGivesBound.
rewrite <- (Zabs_eq (Zpower_nat radix precision)); auto with zarith.
apply Zlt_Zabs_inv2; auto.
apply Rmult_le_reg_l with (r := powerRZ radix (Fexp p + Fexp q));
auto with real zarith.
repeat rewrite (Rmult_comm (powerRZ radix (Fexp p + Fexp q))); auto.
rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with real zarith.
case
(FboundedMbound _ radixMoreThanOne b precision)
with
(z := (precision + (Fexp p + Fexp q))%Z)
(m := Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision));
auto with zarith.
apply Zmult_le_reg_r with (p := Zpower_nat radix precision); auto with zarith.
apply Zlt_gt; auto with zarith.
pattern (Zpower_nat radix precision) at 2 in |- *;
rewrite <- (fun x => Zabs_eq (Zpower_nat radix x)).
rewrite <- Zabs_Zmult.
apply Zle_trans with (1 := H'6); auto with zarith.
rewrite Zabs_Zmult.
apply Zle_trans with (Zpower_nat radix precision * Zabs (Fnum q))%Z.
apply Zle_Zmult_comp_r; auto with zarith.
apply Zlt_le_weak; rewrite <- pGivesBound; case Fp; auto with float.
apply Zle_Zmult_comp_l; auto with zarith.
apply Zlt_le_weak; rewrite <- pGivesBound; case Fq; auto with float.
auto with zarith.
intros x0 (H'8, H'9); rewrite <- H'9.
case H'2.
intros H'10 (H'11, H'12); apply H'12; auto.
rewrite H'9; auto.
rewrite powerRZ_add; auto with real zarith.
rewrite <- Rmult_assoc.
unfold FtoRradix in |- *; rewrite <- Fmult_correct; auto with zarith.
unfold Fmult, FtoR in |- *; simpl in |- *.
repeat rewrite (fun x => Rmult_comm x (powerRZ radix (Fexp p + Fexp q))).
apply Rmult_le_compat_l; auto with real zarith.
rewrite <- Zpower_nat_Z_powerRZ; auto with zarith.
pattern (Fnum p * Fnum q)%Z at 2 in |- *;
rewrite <- (Zabs_eq (Fnum p * Fnum q)); auto.
rewrite <- Rmult_IZR; apply Rle_IZR; apply Zle_Zabs_inv2; auto.
simpl in |- *; auto.
apply Zmin_n_n; auto.
Qed.

(* Specifications: *)
Theorem errorBoundedMultMax :
forall p q fmax : float,
Fbounded b p ->
Fbounded b q ->
(0 <= p)%R ->
(0 <= q)%R ->
(- dExp b <= Fexp p + Fexp q)%Z ->
isMax b radix (p * q) fmax ->
exists r : float,
FtoRradix r = (p * q - fmax)%R /\
Fbounded b r /\ Fexp r = (Fexp p + Fexp q)%Z.