intros x y H H0 H1.
cut (forall z : float, Fexp z = Fexp (Fabs z) :>Z);
[ intros E | intros; unfold Fabs in |- *; simpl in |- *; auto with zarith ].
rewrite (E x); rewrite (E y).
cut (Fcanonic (Fabs x)); [ intros D | apply FcanonicFabs; auto ].
cut (Fcanonic (Fabs y)); [ intros G | apply FcanonicFabs; auto ].
case H1; intros Z2.
case (FcanonicLtPos (Fabs x) (Fabs y)); auto with zarith.
rewrite (Fabs_correct radix); auto with real zarith.
repeat rewrite (Fabs_correct radix); auto with real zarith.
rewrite (FcanonicUnique (Fabs x) (Fabs y)); auto with float zarith.
repeat rewrite (Fabs_correct radix); auto with real zarith.
Qed.

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