Section Fnormalized_Def.
Variable radix : Z.
Hypothesis radixMoreThanOne : (1 < radix)%Z.
Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Variable b : Fbound.
Definition Fnormal (p : float) :=
Fbounded b p /\ (Zpos (vNum b) <= Z.abs (radix * Fnum p))%Z.
intros p H; case H; auto.
Qed.
intros p H; case H; auto.
Qed.
Hint Resolve FnormalBounded FnormalBound: float.
unfold is_Fzero in |- *; intros p H; red in |- *; intros H1.
case H; rewrite H1.
replace (Z.abs (radix * 0)) with 0%Z; auto with zarith.
rewrite Zmult_comm; simpl in |- *; auto.
Qed.
intros p H; split; auto with float.
replace (Z.abs (radix * Fnum (Fopp p))) with (Z.abs (radix * Fnum p));
auto with float.
case p; simpl in |- *; auto with zarith.
intros Fnum1 Fexp1; rewrite <- Zopp_mult_distr_r; apply sym_equal;
apply Zabs_Zopp.
Qed.
intros p; case p; intros a e H; split; auto with float.
simpl in |- *; case H; intros H1 H2; simpl in |- *; auto.
rewrite <- (Z.abs_eq radix); auto with zarith.
rewrite <- Zabs_Zmult.
rewrite (fun x => Z.abs_eq (Z.abs x)); auto with float zarith.
Qed.
Definition pPred x := Z.pred (Zpos x).
intros p z H H0; unfold FtoRradix in |- *.
rewrite <-
(FshiftCorrect _ radixMoreThanOne (Z.abs_nat (z - Fexp p))
(Float (pPred (vNum b)) z)).
unfold FtoR, Fabs in |- *; simpl in |- *; auto with zarith.
rewrite Rmult_IZR; rewrite Zpower_nat_Z_powerRZ; auto with zarith.
repeat rewrite inj_abs; auto with zarith.
replace (z - (z - Fexp p))%Z with (Fexp p); [ idtac | ring ].
rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with real zarith.
replace (z - Fexp p + Fexp p)%Z with z; [ idtac | ring ].
apply Rle_trans with (pPred (vNum b) * powerRZ radix (Fexp p))%R.
apply Rle_monotone_exp; auto with zarith; repeat rewrite Rmult_IZR;
apply Rle_IZR; unfold pPred in |- *; apply Zle_Zpred;
auto with float real zarith.
apply Rmult_le_compat_l; auto with real zarith.
replace 0%R with (IZR 0); auto with real; apply Rle_IZR; unfold pPred in |- *;
apply Zle_Zpred; auto with float zarith.
apply Rle_powerRZ; auto with float real zarith.
Qed.
intros p H'; unfold FtoRradix, FtoR in |- *; simpl in |- *.
pattern (Fexp p) at 2 in |- *; replace (Fexp p) with (Z.succ (Z.pred (Fexp p)));
[ rewrite powerRZ_Zs; auto with real zarith
| unfold Z.succ, Z.pred in |- *; ring ].
repeat rewrite <- Rmult_assoc.
apply Rmult_lt_compat_r; auto with real arith.
rewrite <- Rmult_IZR; apply Rlt_IZR.
unfold pPred in |- *; cut (Zpos (vNum b) <= Z.abs (Fnum p) * radix)%Z;
auto with zarith.
rewrite <- (Z.abs_eq radix); auto with float zarith; rewrite <- Zabs_Zmult;
rewrite Zmult_comm; auto with float real zarith.
Qed.
Definition Fsubnormal (p : float) :=
Fbounded b p /\
Fexp p = (- dExp b)%Z /\ (Z.abs (radix * Fnum p) < Zpos (vNum b))%Z.
intros p H; case H; auto.
Qed.
intros p H; case H; auto.
intros H1 H2; case H2; auto.
Qed.
intros p H; case H; auto.
intros H1 H2; case H2; auto.
Qed.
Hint Resolve FsubnormalFbounded FsubnormalBound FsubnormalFexp: float.
intros p H'; repeat split; simpl in |- *; auto with zarith float.
rewrite Zabs_Zopp; auto with float.
rewrite <- Zopp_mult_distr_r; rewrite Zabs_Zopp; auto with float.
Qed.
intros p; case p; intros a e H; split; auto with float.
simpl in |- *; split; auto with float.
case H; intros H1 (H2, H3); auto.
rewrite <- (Z.abs_eq radix); auto with zarith.
rewrite <- Zabs_Zmult.
rewrite (fun x => Z.abs_eq (Z.abs x)); auto with float zarith.
case H; intros H1 (H2, H3); auto.
Qed.
intros p q H' H'0 H'1.
apply FtoREqInv2 with (radix := radix); auto.
generalize H' H'0; unfold Fsubnormal in |- *; auto with zarith.
Qed.
intros p q H' H'0 H'1.
apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith.
apply trans_equal with (- dExp b)%Z.
case H'; auto.
intros H1 H2; case H2; auto.
apply sym_equal; case H'0; auto.
intros H1 H2; case H2; auto.
Qed.
intros p q H' H'0 H'1.
case (Rtotal_order p q); auto; intros Test; case Test; clear Test;
intros Test; Contradict H'1.
unfold FtoRradix in Test; rewrite sameExpEq with (2 := Test); auto.
auto with zarith.
apply trans_equal with (- dExp b)%Z.
case H'; auto.
intros H1 H2; case H2; auto.
apply sym_equal; case H'0.
intros H1 H2; case H2; auto.
apply Zle_not_lt.
apply Zlt_le_weak.
apply FsubnormalLt; auto.
Qed.
Definition Fcanonic (a : float) := Fnormal a \/ Fsubnormal a.
intros p H; case H; auto with float.
Qed.
Hint Resolve FcanonicBound: float.
auto with float.
Qed.
intros p H'; case H'; intros H'1.
left; apply FnormalFop; auto.
right; apply FsubnormFopp; auto.
Qed.

Theorem FcanonicFabs : forall p : float, Fcanonic p -> Fcanonic (Fabs p).