intros b p q H' H'0 H'1; split.
apply Zle_lt_trans with (Zabs (Fnum p)); [ idtac | auto with float ].
apply
Zle_trans with (Zabs (Fnum (Fshift radix (Zabs_nat (Fexp q - Fexp p)) q)));
auto.
unfold Fshift in |- *; simpl in |- *; auto.
rewrite Zabs_Zmult.
pattern (Zabs (Fnum q)) at 1 in |- *;
replace (Zabs (Fnum q)) with (Zabs (Fnum q) * 1%nat)%Z;
[ apply Zle_Zmult_comp_l | auto with zarith ]; auto with zarith.
rewrite Zabs_eq; simpl in |- *; auto with zarith.
simpl in |- *; ring.
cut (Fexp p <= Fexp q)%Z; [ intros E2 | idtac ].
apply le_IZR; auto.
apply (Rle_monotony_contra_exp radix) with (z := Fexp p);
auto with real arith.
pattern (Fexp p) at 2 in |- *;
replace (Fexp p) with (Fexp (Fshift radix (Zabs_nat (Fexp q - Fexp p)) q));
auto.
rewrite <- (fun x => Rabs_pos_eq (powerRZ radix x)); auto with real zarith.
rewrite <- Faux.Rabsolu_Zabs.
rewrite <- Rabs_mult.
change
(Rabs (FtoRradix (Fshift radix (Zabs_nat (Fexp q - Fexp p)) q)) <=
Zabs (Fnum p) * powerRZ radix (Fexp p))%R in |- *.
unfold FtoRradix in |- *; rewrite FshiftCorrect; auto.
fold FtoRradix in |- *; rewrite <- H'0.
rewrite <- (Fabs_correct radix); auto with real zarith.
unfold Fshift in |- *; simpl in |- *.
rewrite inj_abs; [ ring | auto with zarith ].
cut (Fexp p <= Fexp q)%Z; [ intros E2 | apply le_IZR ]; auto.
apply Zle_trans with (Fexp p); [ idtac | apply le_IZR ]; auto with float.
Qed.

(* Specifications: *)
Theorem eqExpLess :
forall (b : Fbound) (p q : float),
Fbounded b p ->
p = q :>R ->
exists r : float, Fbounded b r /\ r = q :>R /\ (Fexp q <= Fexp r)%R.