intros r q.
case (Zle_or_lt (Fexp (boundR r)) (Fexp q)); intros H'.
intros H'0 H'1 H'2 H'3; case H'0.
apply is_Fzero_rep2 with (radix := radix); auto.
rewrite <-
FshiftCorrect with (n := Zabs_nat (Fexp q - Fexp (boundR r))) (x := q);
auto with arith.
apply is_Fzero_rep1 with (radix := radix).
unfold is_Fzero in |- *.
cut (forall p : Z, (- 1%nat < p)%Z -> (p < 1%nat)%Z -> p = 0%Z);
[ intros tmp; apply tmp | idtac ].
replace (- 1%nat)%Z with (Fnum (Fopp (boundR r))).
apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with real zarith.
rewrite FshiftCorrect; auto.
unfold Fshift in |- *; simpl in |- *.
rewrite (fun x y => inj_abs (x - y)); auto with zarith.
simpl in |- *; auto.
replace (Z_of_nat 1) with (Fnum (boundR r)).
apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith.
rewrite FshiftCorrect; auto.
unfold Fshift in |- *; simpl in |- *.
rewrite inj_abs; auto with zarith.
generalize H'; simpl in |- *; auto with zarith.
simpl in |- *; auto.
intros p0; case p0; simpl in |- *; auto with zarith.
intros H'0 H'1 H'2 H'3; unfold mBFloat in |- *.
replace q with
((fun p : Z * Z => Float (fst p) (snd p)) (Fnum q, Fexp q)).
apply in_map with (f := fun p : Z * Z => Float (fst p) (snd p));
auto.
apply mProd_correct; auto.
apply mZlist_correct; auto with float.
apply Zle_Zabs_inv1; auto with float.
unfold pPred in |- *; apply Zle_Zpred; auto with float.
apply Zle_Zabs_inv2; auto with float.
unfold pPred in |- *; apply Zle_Zpred; auto with float.
apply mZlist_correct; auto with float.
auto with zarith.
case q; simpl in |- *; auto with zarith.
Qed.

(* Specifications: *)
Theorem mBFadic_correct2 : forall r : R, In (boundR r) (mBFloat r).
intros r; unfold mBFloat in |- *.