intros P p r H' H'0 H'1.
cut (Float (- 1%nat) (- dExp b) < 0)%R;
[ intros Rl0
| unfold FtoRradix, FtoR in |- *; simpl in |- *; unfold IZR at 1; rewrite Ropp_mult_distr_l_reverse;
rewrite Rmult_1_l;
auto with real arith ].
2: replace 0%R with (-0)%R; auto with real arith; ring.
cut (r < 0)%R; [ intros Rl1 | apply Rle_lt_trans with (2 := Rl0) ]; auto.
cut (r <= 0)%R; [ intros Rl2 | apply Rlt_le; auto ].
case H'.
intros H'2 H'3; Elimc H'3; intros H'3 H'4; Elimc H'4; intros H'4 H'5;
case (H'4 r p); auto; intros H'6.
case (MaxEx b radix precision) with (r := r); auto with arith;
intros max Hmax.
cut (Fbounded b (Float (Fnum max) (Zsucc (Fexp max)))); [ intros F2 | idtac ].
cut (FtoRradix (Float (Fnum max) (Zsucc (Fexp max))) = (radix * max)%R :>R);
[ intros F2Eq | idtac ].
apply Rle_trans with (FtoRradix (Float (Fnum max) (Zsucc (Fexp max)))).
rewrite F2Eq; auto with real.
apply Rmult_le_compat_l; auto with real arith.
replace 0%R with (INR 0); auto with real arith.
apply isMax_inv1 with (1 := Hmax); auto.
case H'6.
intros H'7 H'8; elim H'8; intros H'9 H'10; apply H'10; clear H'8; auto.
case (Rle_or_lt (Float (Fnum max) (Zsucc (Fexp max))) r); auto; intros Rlt0.
absurd (max <= Float (Fnum max) (Zsucc (Fexp max)))%R.
apply Rgt_not_le.
rewrite F2Eq.
replace (radix * max)%R with (- (- max * radix))%R; [ idtac | ring ].
pattern (FtoRradix max) at 1 in |- *;
replace (FtoRradix max) with (- (- max * 1%nat))%R;
[ idtac | simpl in |- *; ring ].
apply Ropp_lt_gt_contravar; apply Rmult_lt_compat_l; auto with real.
replace 0%R with (-0)%R; [ apply Ropp_lt_contravar | ring ].
case (RleMaxR0 r max); auto.
intros H'8; case H'1.
intros H'11; absurd (max <= Float (- 1%nat) (- dExp b))%R.
apply Rgt_not_le; auto.
rewrite H'8; auto.
apply
(MonotoneMax b radix)
with (q := FtoRradix (Float (- 1%nat) (- dExp b))) (p := r);
auto.
apply (RoundedModeProjectorIdem (isMax b radix)); auto.
apply MaxRoundedModeP with (precision := precision); auto.
repeat split.
simpl in |- *; auto with zarith.
apply (vNumbMoreThanOne radix) with (precision := precision);
auto with zarith.
simpl in |- *; auto with zarith.
intros H'11; absurd (Float (- 1%nat) (- dExp b) = max :>R).
rewrite H'8; auto.
apply Rlt_dichotomy_converse; left; auto.
apply (MaxUniqueP b radix r); auto.
rewrite H'11.
apply (RoundedModeProjectorIdem (isMax b radix)); auto.
apply MaxRoundedModeP with (precision := precision); auto.
repeat split.
simpl in |- *; auto with zarith.
apply (vNumbMoreThanOne radix) with (precision := precision);
auto with zarith.
simpl in |- *; auto with zarith.
case Hmax.
intros H'8 H'11; elim H'11; intros H'12 H'13; apply H'13; clear H'11; auto.
apply Rlt_le; auto.
unfold FtoRradix, FtoR in |- *; simpl in |- *.
rewrite powerRZ_Zs; auto with real zarith; ring.
cut (Fbounded b max);
[ unfold Fbounded in |- *; intros Fb0 | case Hmax; auto ].
elim Fb0; intros H H0; repeat (split; simpl in |- *); auto.
apply Zle_trans with (Fexp max); auto with zarith.
apply Rle_trans with r; auto with real.
pattern r at 2 in |- *; replace r with (- (- r * 1%nat))%R; [ idtac | simpl; ring ].
replace (radix * r)%R with (- (- r * radix))%R; [ idtac | ring ].
apply Ropp_le_contravar; apply Rmult_le_compat_l; auto with real arith.
replace 0%R with (-0)%R; auto with real arith.
apply isMax_inv1 with (1 := H'6).
Qed.

(* Specifications: *)
Theorem roundedModeAbsMult :
forall (P : R -> float -> Prop) (p : float) (r : R),
RoundedModeP b radix P ->
P r p ->
(Float 1%nat (- dExp b) <= Rabs r)%R -> (Rabs p <= radix * Rabs r)%R.