intros P H' f1 f2 H'0 H'1 H'2.
case (Rle_or_lt 0 f1); intros Rl1.
apply Rlt_dichotomy_converse; right; red in |- *.
apply Rlt_le_trans with (r2 := FtoRradix (Float 1%nat (MSB radix f1))); auto.
unfold FtoRradix, FtoR in |- *; simpl in |- *; rewrite Rmult_1_l;
auto with real arith.
cut (Float 1%nat (MSB radix f1) <= Fabs f1)%R; unfold FtoRradix in |- *;
[ rewrite Fabs_correct; auto with arith; rewrite Rabs_right; auto with real;
intros Rl2; Casec Rl2; intros Rl2
| apply MSB_le_abs ]; auto.
cut (MonotoneP radix P);
[ intros Mn | apply RoundedModeP_inv4 with (1 := H'); auto ].
apply (Mn (Float 1%nat (MSB radix f1)) f1); auto.
apply RoundedModeProjectorIdem; auto.
apply (FboundedOne radix) with (precision := precision);
auto with real zarith arith.
replace (FtoR radix f2) with (FtoR radix (Float 1%nat (MSB radix f1)));
auto with float real.
apply RoundedModeProjectorIdemEq with (P := P); auto.
apply (FboundedOne radix) with (precision := precision);
auto with real zarith arith.
cut (CompatibleP b radix P);
[ intros Cp | apply RoundedModeP_inv2 with (1 := H'); auto ].
apply (Cp f1) with (p := f2); auto.
apply RoundedModeBounded with (P := P) (r := FtoRradix f1); auto.
Contradict H'1; unfold FtoRradix in |- *; apply is_Fzero_rep1; auto.
apply Rlt_dichotomy_converse; left.
apply Rle_lt_trans with (r2 := FtoRradix (Float (- 1%nat) (MSB radix f1)));
auto.
cut (MonotoneP radix P);
[ intros Mn | apply RoundedModeP_inv4 with (1 := H'); auto ].
cut (f1 <= Float (- 1%nat) (MSB radix f1))%R;
[ intros Rle1; Casec Rle1; intros Rle1 | idtac ].
apply (Mn f1 (Float (- 1%nat) (MSB radix f1))); auto.
apply RoundedModeProjectorIdem; auto.
apply oppBoundedInv; unfold Fopp in |- *; simpl in |- *.
apply (FboundedOne radix) with (precision := precision);
auto with real zarith arith.
replace (FtoRradix f2) with (FtoRradix (Float (- 1%nat) (MSB radix f1)));
auto with real.
apply RoundedModeProjectorIdemEq with (P := P); auto.
apply oppBoundedInv; unfold Fopp in |- *; simpl in |- *.
apply (FboundedOne _ radixMoreThanOne b precision);
auto with real zarith arith.
cut (CompatibleP b radix P);
[ intros Cp | apply RoundedModeP_inv2 with (1 := H'); auto ].
apply (Cp f1) with (p := f2); auto.
apply RoundedModeBounded with (P := P) (r := FtoRradix f1); auto.
replace (FtoRradix f1) with (- FtoRradix (Fabs f1))%R.
replace (Float (- 1%nat) (MSB radix f1)) with
(Fopp (Float 1%nat (MSB radix f1))).
unfold FtoRradix in |- *; rewrite Fopp_correct; auto.
apply Ropp_le_contravar; apply MSB_le_abs; auto.
Contradict H'1; unfold FtoRradix in |- *; apply is_Fzero_rep1; auto.
unfold Fopp in |- *; simpl in |- *; auto.
unfold FtoRradix in |- *; rewrite Fabs_correct; auto with arith;
rewrite Faux.Rabsolu_left1; try apply Rlt_le; auto;
ring.
replace (Float (- 1%nat) (MSB radix f1)) with
(Fopp (Float 1%nat (MSB radix f1)));
[ idtac | unfold Fopp in |- *; simpl in |- *; auto ].
replace 0%R with (-0)%R; [ idtac | ring ].
unfold FtoRradix in |- *; repeat rewrite Fopp_correct;
apply Ropp_lt_contravar.
unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real arith.
Qed.

(* Specifications: *)
Theorem RoundMSBmax :
forall (P : R -> float -> Prop) (p q : float),
RoundedModeP b radix P ->
P p q ->
p <> 0%R :>R ->
(- dExp b <= MSB radix p)%Z -> (MSB radix q <= Zsucc (MSB radix p))%Z.