intros p q H' H'0 H'1 H'2.
case (Zle_or_lt (Fexp q) (Fexp p)); auto.
intros H'3; right.
case (Zle_lt_or_eq _ _ H'3); intros H'4.
2: split; auto.
2: apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith.
absurd (Fnum (Fshift radix (Zabs_nat (Fexp p - Fexp q)) p) < Fnum q)%Z; auto.
2: apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith.
2: unfold FtoRradix in |- *; rewrite FshiftCorrect; auto.
2: unfold Fshift in |- *; simpl in |- *; auto with zarith.
2: replace (Z_of_nat (Zabs_nat (Fexp p - Fexp q))) with (Fexp p - Fexp q)%Z;
auto with zarith.
2: cut (0 < Fexp p - Fexp q)%Z; auto with zarith.
2: case (Fexp p - Fexp q)%Z; simpl in |- *; auto with zarith.
2: intros p0; rewrite (inject_nat_convert (Zpos p0)); auto with arith.
2: intros p0 H'5; discriminate.
red in |- *; intros H'5.
absurd
(Fdigit radix (Fshift radix (Zabs_nat (Fexp p - Fexp q)) p) <=
Fdigit radix q); auto with arith.
rewrite FshiftFdigit; auto with arith.
replace (Fdigit radix p) with precision.
replace (Fdigit radix q) with precision; auto with zarith.
cut (0 < Fexp p - Fexp q)%Z; auto with zarith.
case (Fexp p - Fexp q)%Z; simpl in |- *; auto with zarith.
intros p0 H'6; generalize (convert_not_O p0); auto with zarith.
intros p0 H'6; discriminate.
apply sym_equal; auto with float.
apply sym_equal; auto with float.
apply FnormalNotZero; auto with arith.
unfold Fdigit in |- *; apply digit_monotone; auto with arith.
repeat rewrite Zabs_eq; auto with zarith.
apply LeR0Fnum with (radix := radix); auto with zarith.
apply Rle_trans with (r2 := FtoRradix p); auto with real.
apply LeR0Fnum with (radix := radix); auto with zarith.
unfold FtoRradix in |- *; rewrite FshiftCorrect; auto.
Qed.

(* Specifications: *)
Theorem FnormalLtNeg :
forall p q : float,
Fnormal p ->
Fnormal q ->
(q <= 0)%R ->
(p < q)%R -> (Fexp q < Fexp p)%Z \/ Fexp p = Fexp q /\ (Fnum p < Fnum q)%Z.