Library Float.Others.FmaEmul

Require Export DblRndOdd.
Require Export FboundI.
Require Export MinOrMax.
Require Export DoubleRound.

Section Prelim.

Variable b : Fbound.
Variable radix : Z.
Variable precision : nat.

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.

Theorem plusExactSub: forall (P : R -> float -> Prop) (x y r : float),
   (RoundedModeP b radix P) ->
     (Fsubnormal radix b x) -> (Fsubnormal radix b y) ->
       (P (x+y)%R r)
   -> (FtoRradix r=x+y)%R.
intros.
unfold FtoRradix; rewrite <- Fplus_correct; auto with zarith; apply sym_eq.
apply RoundedModeProjectorIdemEq with b precision P; auto with zarith.
elim H1; elim H0; intros.
elim H4; elim H6; clear H4 H6; intros.
unfold Fplus; simpl; rewrite Zmin_le1; auto with zarith.
replace (Fnum x * Zpower_nat radix (Zabs_nat (Fexp x - Fexp x)) +
         Fnum y * Zpower_nat radix (Zabs_nat (Fexp y - Fexp x)))%Z with (Fnum x+Fnum y)%Z.
split; simpl; auto with zarith.
apply Zle_lt_trans with ((Zabs (Fnum x)+Zabs (Fnum y)))%Z; auto with zarith.
apply Zmult_lt_reg_r with radix; auto with zarith.
apply Zle_lt_trans with (Zabs (radix * Fnum x)+(Zabs (radix * Fnum y)))%Z.
repeat rewrite Zabs_Zmult; repeat rewrite (Zabs_eq radix); auto with zarith.
replace ((Zabs (Fnum x) + Zabs (Fnum y)) * radix)%Z with
    (radix * Zabs (Fnum x) + radix * Zabs (Fnum y))%Z; auto with zarith; ring.
apply Zlt_le_trans with (Zpos (vNum b) * 2)%Z; auto with zarith.
rewrite H4; rewrite H7; simpl.
ring_simplify (- dExp b - - dExp b)%Z; simpl.
unfold Zpower_nat; simpl; ring.
rewrite Fplus_correct; auto with real zarith.
Qed.

End Prelim.

Section Sec1.

Variable bo : Fbound.
Let radix := 2%Z.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Variable p : nat.

Hypotheses pGreaterThanOne : (lt (S O) p).
Hypotheses pGivesBound : (Zpos (vNum bo)) = (Zpower_nat radix p).

Theorem AddOddEven_aux_aux: forall (x y:float),
        (5* (Rabs y) <= x)%R -> (0 < x)%R
   -> (5*(firstNormalPos radix bo p) <= x)%R
   -> (Fcanonic radix bo y) ->(Fcanonic radix bo x) ->
   (exists k:nat, exists be:Fbound, exists xy:float,
        (1 < k) /\ (Zpos (vNum be)) = (Zpower_nat radix (p+k))
          /\ (- dExp be <= Zpred (Zpred (- dExp bo)))%Z
         /\ (FtoRradix xy =x+y)%R
         /\ (Fnormal radix be xy) /\ (Fexp xy=Fexp y)).
intros.
cut (forall k:nat, exists bb:Fbound,
           Zpos (vNum bb) = Zpower_nat radix k /\
           (Zsucc (Zsucc (dExp bo)) <= dExp bb)%Z).
intros L1.
exists ((FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))))-p+1).
elim L1 with (1+FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y)))).
intros bb T; elim T; intros; clear T L1.
exists bb.
exists (Fplus radix x y).
cut (1 <= Zabs_nat (Fnum (Fplus radix x y)));[intros L1|idtac].
generalize (FNIMore radix); intros T; lapply T; auto with zarith; clear T; intros T.
lapply (T (Zabs_nat (Fnum (Fplus radix x y))) 1); auto with zarith.
clear T; intros T; lapply T; auto; clear T; intros L2.
cut (Zabs_nat (Fnum (Fplus radix x y)) <
      radix *
      (Zpower_nat radix (FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))))))%Z;
  [clear L2; intros L2| apply Zlt_le_trans with (1:=L2)].
2:apply Zmult_le_compat_l; simpl; auto with zarith.
generalize (FNILess radix); intros T; lapply T; auto with zarith; clear T; intros T.
lapply (T 1 (Zabs_nat (Fnum (Fplus radix x y)))); auto with zarith.
clear T; intros T; lapply T; auto; clear T; intros L3.
cut (Zpower_nat radix (FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))))
       <= Zabs_nat (Fnum (Fplus radix x y)))%Z;
  [clear L3; intros L3| apply Zle_trans with (2:=L3)].
2: simpl; auto with zarith.
cut (Fexp (Fplus radix x y) = Fexp y);[intros J1|idtac].
assert (p < FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y)))).
case H2; intros J2.
apply Zpower_nat_anti_monotone_lt with radix; auto with zarith.
apply Zmult_lt_reg_r with radix; auto with zarith.
apply Zle_lt_trans with (Zabs_nat (Fnum (Fplus radix x y))) ; auto with zarith.
2: apply Zlt_le_trans with (1:=L2); auto with zarith.
apply Zle_Rle; rewrite mult_IZR.
apply Rmult_le_reg_l with (powerRZ radix (Fexp (Fplus radix x y))); auto with real zarith.
apply Rle_trans with (Rabs (x+y))%R.
rewrite J1; apply Rle_trans with (Rabs x -Rabs y)%R.
apply Rplus_le_reg_l with (Rabs y).
ring_simplify (Rabs y + (Rabs x - Rabs y))%R.
apply Rle_trans with (5*Rabs y)%R.
apply Rle_trans with ((Rabs y)+4*Rabs y)%R;[apply Rplus_le_compat_l|right; ring].
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith; unfold Fabs, FtoR.
simpl.
apply Rle_trans with ((powerRZ 2 (Fexp y))*((2*(Zabs (Fnum y)))*2))%R;
  [idtac|right; ring].
apply Rmult_le_compat_l; auto with real zarith.
apply Rmult_le_compat_r; auto with real zarith.
elim J2; intros.
rewrite <- pGivesBound; rewrite Zabs_Zmult in H7.
rewrite Zabs_eq in H7; auto with real zarith.
apply Rle_trans with (IZR (radix * Zabs (Fnum y))); auto with real zarith.
rewrite mult_IZR; simpl; auto with zarith real.
rewrite Rabs_right with x; [idtac|apply Rle_ge];auto with real.
rewrite <- Rabs_Ropp with x.
apply Rle_trans with (Rabs (-x-y))%R.
apply Rabs_triang_inv.
replace (-x-y)%R with (-(x+y))%R; [rewrite Rabs_Ropp;auto with real|ring].
unfold FtoRradix; rewrite <- Fplus_correct; auto with zarith.
rewrite <- Fabs_correct; auto with zarith; unfold FtoR, Fabs; simpl; right; ring_simplify.
rewrite Zabs_absolu; ring.
apply Zpower_nat_anti_monotone_lt with radix; auto with zarith.
apply Zmult_lt_reg_r with radix; auto with zarith.
apply Zle_lt_trans with (Zabs_nat (Fnum (Fplus radix x y))) ; auto with zarith.
2: apply Zlt_le_trans with (1:=L2); auto with zarith.
apply Zle_Rle; rewrite mult_IZR.
apply Rmult_le_reg_l with (powerRZ radix (Fexp (Fplus radix x y))); auto with real zarith.
apply Rle_trans with (Rabs (x+y))%R.
rewrite J1; apply Rle_trans with (Rabs x -Rabs y)%R.
apply Rmult_le_reg_l with 5%R; auto with real.
apply Rlt_le_trans with 2%R; auto with real.
apply Rle_trans with 4%R; auto with real.
apply Rle_trans with (4+1)%R; auto with real.
apply Rle_trans with (4*(5*(firstNormalPos radix bo p)))%R.
right; unfold firstNormalPos, nNormMin, FtoRradix, FtoR; simpl.
elim J2; intros T1 T2; elim T2; intros T3 T4; rewrite T3.
replace (Zpower_nat radix p) with (2*(Zpower_nat radix (pred p)))%Z.
rewrite mult_IZR; simpl; ring.
pattern p at 2; replace p with (1+pred p); auto with zarith.
apply Rle_trans with (4*x)%R; auto with real.
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with 2%R; auto with real.
rewrite (Rabs_right x);[idtac| apply Rle_ge; auto with real].
apply Rplus_le_reg_l with ((5*Rabs y)-4*x)%R.
ring_simplify.
apply Rle_trans with (2:=H); right; ring.
rewrite <- Rabs_Ropp with x.
apply Rle_trans with (Rabs (-x-y))%R.
apply Rabs_triang_inv.
replace (-x-y)%R with (-(x+y))%R; [rewrite Rabs_Ropp;auto with real|ring].
unfold FtoRradix; rewrite <- Fplus_correct; auto with zarith.
rewrite <- Fabs_correct; auto with zarith; unfold FtoR, Fabs; simpl; right; ring_simplify.
rewrite Zabs_absolu; ring.
split; auto with zarith.
split;[rewrite H4; auto with zarith|idtac].
split.
apply Zle_trans with (-(Zsucc (Zsucc (dExp bo))))%Z; auto with zarith.
unfold Zsucc, Zpred; auto with zarith.
split;[unfold FtoRradix; rewrite Fplus_correct; auto with real zarith|idtac].
split; auto.
split;[split|idtac].
rewrite Zabs_absolu; apply Zlt_le_trans with (1:=L2).
rewrite H4; rewrite Zpower_nat_is_exp; auto with zarith.
rewrite J1; apply Zle_trans with (-(dExp bo))%Z; auto with zarith.
case H2; intros T; elim T; intros T1 T2; elim T1; auto.
rewrite H4; rewrite Zpower_nat_is_exp; auto with zarith.
rewrite Zabs_Zmult.
replace (Zpower_nat radix 1) with (Zabs radix); auto with zarith.
apply Zmult_le_compat_l; auto with zarith.
rewrite Zabs_absolu; auto.
unfold Fplus; simpl.
apply Zmin_le2.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
fold FtoRradix; apply Rle_trans with (1*Rabs y)%R;[right; ring|idtac].
apply Rle_trans with (5*Rabs y)%R;[apply Rmult_le_compat_r; auto with real|idtac].
apply Rle_trans with (4+1)%R; auto with real.
apply Rle_trans with 2%R; auto with real.
apply Rle_trans with 4%R; auto with real.
apply Rle_trans with (1:=H); rewrite Rabs_right;[idtac|apply Rle_ge]; auto with real.
assert (1 <= Zabs_nat (Fnum (Fplus radix x y)))%Z; auto with zarith.
rewrite <- Zabs_absolu.
cut (0 < Fnum (Fplus radix x y))%Z; auto with zarith.
intros K; rewrite Zabs_eq; auto with zarith.
apply LtR0Fnum with radix; auto with zarith.
rewrite Fplus_correct; auto with zarith; fold FtoRradix.
apply Rplus_lt_reg_r with (-y)%R.
ring_simplify.
case (Req_dec 0 y); intros K.
rewrite <-K; ring_simplify (-0)%R; auto with real.
apply Rle_lt_trans with (Rabs (-y))%R; auto with real.
apply RRle_abs.
rewrite Rabs_Ropp; apply Rlt_le_trans with (2:=H).
apply Rle_lt_trans with (1*Rabs y)%R; auto with real.
apply Rmult_lt_compat_r.
assert (0 <= Rabs y)%R; auto with real.
case H6; auto; intros K'.
absurd ( Rabs y=0)%R; auto.
apply Rabs_no_R0; auto.
apply Rlt_le_trans with (4+1)%R;auto with real.
apply Rle_lt_trans with 4%R; auto with real.
apply Rle_trans with 2%R; auto with real.
intros k.
exists (Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix k))))
    ((Nsucc (Nsucc (dExp bo))))).
split; simpl.
apply trans_eq with
    (Z_of_nat
       (nat_of_P
          (P_of_succ_nat
             (pred (Zabs_nat (Zpower_nat radix k)))))); auto with zarith.
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
 auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
rewrite <- (S_pred (Zabs_nat (Zpower_nat radix (k))) 0);
 auto with arith zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
cut (0 < Zabs_nat (Zpower_nat radix k))%Z; auto with zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
case (dExp bo); simpl; auto with zarith.
intros; case p0; simpl; auto with zarith.
Qed.

Theorem AddOddEven_aux: forall (x y f1 f2:float) (z:R),
   (5* (Rabs y) <= x)%R -> (0 < x)%R ->
   (5*(firstNormalPos radix bo p) <= x)%R ->
   (Fcanonic radix bo y) ->(Fcanonic radix bo x) ->
   (To_Odd bo radix p z y) ->
   (EvenClosest bo radix p (x+y)%R f1) ->
   (EvenClosest bo radix p (x+z)%R f2) ->
       (FtoRradix f1=f2)%R.
intros.
elim H4; intros.
case H8; clear H8; intros H8.
generalize EvenClosestUniqueP; unfold UniqueP; intros T.
unfold FtoRradix; apply T with bo p (x+z)%R; auto with zarith.
rewrite H8; auto with real.
elim (AddOddEven_aux_aux x y); auto.
intros k T1; elim T1; intros be T2; elim T2; intros xy T3; clear T1 T2.
elim T3; intros H8' T4; elim T4; intros H9 T5; elim T5; clear T3 T4 T5.
intros H10 T6; elim T6; intros H11 T7; elim T7; intros; clear T6 T7.
apply sym_eq.
apply trans_eq with (FtoRradix (Fnormalize radix bo p f2)).
apply sym_eq; unfold FtoRradix; apply FnormalizeCorrect; auto with zarith.
cut (Fbounded bo f2);[intros Ff2|elim H6; intros T1 T2; elim T1; auto].
apply To_Odd_Even_is_Even with bo be p k xy (x+z)%R; auto.
elim H12; auto.
apply FnormalizeBounded; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
2: replace (FtoR 2 xy) with (x+y)%R; auto with real.
2: apply EvenClosestCompatible with (4:=H6); auto with real zarith.
2: apply sym_eq; apply FnormalizeCorrect; auto with zarith.
2: apply FnormalizeBounded; auto with zarith.
unfold To_Odd.
split;[elim H12; auto|idtac].
right.
cut (FNodd be 2 (p + k) xy);[intros Y|idtac].
split; auto.
elim H8; intros; case H14; intros.
clear H8 H14; elim H16; intros T1 T2; elim T2; clear T1 T2; intros.
left; split;[elim H12; auto|split].
fold radix; fold FtoRradix; rewrite H11; auto with real.
fold radix; intros f U1 U2.
rewrite <- FPredSuc with be radix (p+k) xy; auto with zarith.
2: left; auto.
rewrite <- FnormalizeCorrect with radix be (p+k) f; auto with zarith.
apply FPredProp; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
apply FSuccCanonic; auto with zarith; left; auto.
rewrite FnormalizeCorrect; auto with zarith.
apply Rle_lt_trans with (1:=U2).
apply Rplus_lt_reg_r with (-FtoRradix xy)%R.
apply Rle_lt_trans with (z-y)%R;[rewrite H11; right; ring|idtac].
apply Rlt_le_trans with (FtoRradix ( Float 1%nat (Fexp y))).
apply Rplus_lt_reg_r with (FtoRradix y).
apply Rle_lt_trans with z;[right; ring|idtac].
apply Rlt_le_trans with (FSucc bo radix p y).
case (Rle_or_lt (FSucc bo radix p y) z); auto; intros U3.
absurd ((FSucc bo radix p y <= y))%R.
apply Rlt_not_le.
unfold FtoRradix; apply FSuccLt; auto with zarith.
apply H14; auto.
apply FBoundedSuc; auto with zarith.
right; apply Rplus_eq_reg_l with (-y)%R.
apply trans_eq with (FtoRradix (Fminus radix (FSucc bo radix p y) y)).
unfold FtoRradix; rewrite Fminus_correct; auto with zarith; ring.
unfold FtoRradix; rewrite FSuccDiff1; auto with zarith.
ring.
case (Z_eq_dec (Fnum y) (-(nNormMin radix p))%Z); auto; intros K.
absurd (FNodd bo radix p y); auto.
unfold FNodd; rewrite FcanonicFnormalizeEq; auto with zarith.
unfold Fodd; apply EvenNOdd; rewrite K.
unfold Even, radix, nNormMin.
exists (-(Zpower_nat 2 (pred (pred p))))%Z.
apply trans_eq with (-(Zpower_nat 2 (1+(pred (pred p)))))%Z; auto with zarith.
replace (1+(pred (pred p))) with (pred p); auto with zarith.
rewrite Zpower_nat_is_exp; auto with zarith.
replace (Zpower_nat 2 1) with 2%Z; auto with zarith.
right; apply trans_eq with (FtoRradix (Fminus radix (FSucc be radix (p+k) xy) xy)).
unfold FtoRradix; rewrite FSuccDiff1; auto with zarith real.
rewrite H13; auto with real.
case (Z_eq_dec (Fnum xy) (-(nNormMin radix (p+k)))%Z); auto; intros K.
absurd (FNodd be radix (p+k) xy); auto.
unfold FNodd; rewrite FcanonicFnormalizeEq; auto with zarith.
2: left; auto.
unfold Fodd; apply EvenNOdd; rewrite K.
unfold Even, radix, nNormMin.
exists (-(Zpower_nat 2 (pred (pred (p+k)))))%Z.
apply trans_eq with (-(Zpower_nat 2 (1+(pred (pred (p+k))))))%Z; auto with zarith.
replace (1+(pred (pred (p+k)))) with (pred (p+k)); auto with zarith.
rewrite Zpower_nat_is_exp; auto with zarith.
replace (Zpower_nat 2 1) with 2%Z; auto with zarith.
unfold FtoRradix; rewrite Fminus_correct; auto with zarith; ring.
clear H7 H14; elim H16; intros T1 T2; elim T2; clear T1 T2; intros.
right; split;[elim H12; auto|split].
fold radix; fold FtoRradix; rewrite H11; auto with real.
fold radix; intros f U1 U2.
rewrite <- FSucPred with be radix (p+k) xy; auto with zarith.
2: left; auto.
rewrite <- FnormalizeCorrect with radix be (p+k) f; auto with zarith.
apply FSuccProp; auto with zarith.
apply FPredCanonic; auto with zarith; left; auto.
apply FnormalizeCanonic; auto with zarith.
rewrite FnormalizeCorrect; auto with zarith.
apply Rlt_le_trans with (2:=U2).
apply Rplus_lt_reg_r with (-FtoRradix xy)%R.
apply Rlt_le_trans with (z-y)%R;[idtac|rewrite H11; right; ring].
apply Rle_lt_trans with (-(FtoRradix ( Float 1%nat (Fexp y))))%R.
right; apply trans_eq with (-(FtoRradix (Fminus radix xy (FPred be radix (p+k) xy))))%R.
unfold FtoRradix; rewrite Fminus_correct; auto with zarith; ring.
unfold FtoRradix; rewrite FPredDiff1; auto with zarith real.
rewrite H13; auto with real.
case (Z_eq_dec (Fnum xy) ((nNormMin radix (p+k)))%Z); auto with zarith; intros K.
absurd (FNodd be radix (p+k) xy); auto.
unfold FNodd; rewrite FcanonicFnormalizeEq; auto with zarith.
2: left; auto.
unfold Fodd; apply EvenNOdd; rewrite K.
unfold Even, radix, nNormMin.
exists ((Zpower_nat 2 (pred (pred (p+k)))))%Z.
apply trans_eq with ((Zpower_nat 2 (1+(pred (pred (p+k))))))%Z; auto with zarith.
apply Rplus_lt_reg_r with (FtoRradix y).
apply Rlt_le_trans with z;[idtac|right; ring].
apply Rle_lt_trans with (FPred bo radix p y).
right; apply Rplus_eq_reg_l with (-y)%R.
apply trans_eq with (-(FtoRradix (Fminus radix y (FPred bo radix p y))))%R.
unfold FtoRradix; rewrite FPredDiff1; auto with zarith.
ring.
case (Z_eq_dec (Fnum y) ((nNormMin radix p))%Z); auto; intros K.
absurd (FNodd bo radix p y); auto.
unfold FNodd; rewrite FcanonicFnormalizeEq; auto with zarith.
unfold Fodd; apply EvenNOdd; rewrite K.
unfold Even, radix, nNormMin.
exists ((Zpower_nat 2 (pred (pred p))))%Z.
apply trans_eq with ((Zpower_nat 2 (1+(pred (pred p)))))%Z; auto with zarith.
unfold FtoRradix; rewrite Fminus_correct; auto with zarith; ring.
case (Rle_or_lt z (FPred bo radix p y)); auto; intros U3.
absurd (y <= (FPred bo radix p y))%R.
apply Rlt_not_le.
unfold FtoRradix; apply FPredLt; auto with zarith.
apply H14; auto.
apply FBoundedPred; auto with zarith.
apply FcanonicBound with radix; auto.
elim H8; intros T; clear T;unfold FNodd.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
2: left; auto.
unfold Fodd; unfold Odd; intros T; elim T; intros ny U1.
exists (ny+(Fnum x*(Zpower_nat radix (Zabs_nat (Fexp x-Fexp y -1)))))%Z.
assert (Fexp (Fplus radix x y)=Fexp y)%Z.
unfold Fplus; simpl;apply Zmin_le2.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
fold FtoRradix; apply Rle_trans with (1*Rabs y)%R;[right; ring|idtac].
apply Rle_trans with (5*Rabs y)%R;[apply Rmult_le_compat_r; auto with real|idtac].
apply Rle_trans with (4+1)%R; auto with real.
apply Rle_trans with 2%R; auto with real.
apply Rle_trans with 4%R; auto with real.
apply Rle_trans with (1:=H); rewrite Rabs_right;[idtac|apply Rle_ge]; auto with real.
apply trans_eq with (Fnum (Fplus radix x y)).
apply eq_IZR.
apply Rmult_eq_reg_l with (powerRZ radix (Fexp y)); auto with real zarith.
apply trans_eq with (FtoRradix xy);
   [rewrite <- H13; unfold FtoRradix, FtoR; auto with real|idtac].
rewrite H11; unfold FtoRradix; rewrite <- Fplus_correct; auto with zarith.
unfold FtoR; rewrite H14; auto with real.
unfold Fplus.
replace (Zmin (Fexp x) (Fexp y)) with (Fexp y).
replace (Fnum y * Zpower_nat radix (Zabs_nat (Fexp y - Fexp y)))%Z with (Fnum y); auto with zarith.
apply trans_eq with (Fnum x * Zpower_nat radix (Zabs_nat (Fexp x - Fexp y)) + Fnum y)%Z; auto with zarith.
rewrite U1; ring_simplify.
replace (Zabs_nat (Fexp x - Fexp y)) with (1+(Zabs_nat (Fexp x - Fexp y - 1))).
rewrite Zpower_nat_is_exp; auto with zarith.
replace (Zpower_nat radix 1) with 2%Z; auto with zarith; ring.
cut (1 + Zabs_nat (Fexp x - Fexp y - 1) = Zabs_nat (Fexp x - Fexp y))%Z; auto with zarith.
cut (0 <= Fexp x-Fexp y -1)%Z;[intros U2|idtac].
repeat rewrite <- Zabs_absolu; repeat rewrite Zabs_eq; auto with zarith.
apply Zplus_le_reg_r with (Fexp y+1)%Z.
ring_simplify.
case H2; intros K.
apply Zle_trans with (Fexp (Float (Fnum y) (Fexp y+1)%Z)); auto with zarith.
rewrite Zplus_comm; auto with zarith.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
elim K; intros H15 H16; elim H15; intros.
left; split;[split|simpl]; auto with zarith.
apply Zle_trans with (1:=H18); rewrite Zplus_comm; simpl; auto with zarith.
fold FtoRradix; apply Rle_trans with (2*Rabs y)%R.
unfold FtoRradix, FtoR; rewrite Zplus_comm; simpl.
rewrite powerRZ_add; auto with real zarith.
repeat rewrite Rabs_mult.
replace (Rabs (powerRZ 2 1)) with 2%R;[right; ring|idtac].
unfold powerRZ; simpl; auto with real.
ring_simplify (2*1)%R; rewrite Rabs_right; auto with real; apply Rle_ge; auto with real.
apply Rle_trans with (5*Rabs y)%R;[apply Rmult_le_compat_r; auto with real|idtac].
apply Rle_trans with (4+1)%R; auto with real.
apply Rle_trans with 4%R; auto with real.
apply Rle_trans with (1:=H); rewrite Rabs_right;[idtac|apply Rle_ge]; auto with real.
apply Zle_trans with (Fexp (Float (nNormMin radix p) (-(dExp bo)+1))).
elim K; intros K1 K2; elim K2; intros K3 K4; rewrite K3.
rewrite Zplus_comm; simpl; auto with zarith.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
left; repeat split.
simpl; rewrite pGivesBound.
rewrite Zabs_eq; auto with zarith.
unfold nNormMin in |- *; simpl in |- *; auto with zarith arith.
apply Zlt_le_weak; auto with zarith.
apply nNormPos; auto with zarith.
simpl; auto with zarith.
rewrite pGivesBound.
pattern p at 1; replace p with (pred p + 1); auto with zarith.
rewrite Zabs_Zmult; rewrite Zabs_eq; auto with zarith.
rewrite Zabs_eq; auto with zarith.
rewrite Zpower_nat_is_exp; auto with zarith.
unfold nNormMin in |- *; simpl in |- *; auto with zarith arith.
fold FtoRradix; rewrite (Rabs_right x); try apply Rle_ge; auto with real.
apply Rle_trans with (2:=H1).
rewrite Rabs_right;[idtac|
  apply Rle_ge; unfold FtoRradix; apply LeFnumZERO; auto with zarith].
2: simpl; unfold nNormMin; auto with zarith.
unfold firstNormalPos, FtoRradix, FtoR; simpl.
apply Rle_trans with (nNormMin radix p * (5*powerRZ 2 (- dExp bo)))%R;
   [apply Rmult_le_compat_l; auto with real zarith|right; ring].
unfold nNormMin; auto with zarith real.
rewrite powerRZ_add; auto with real zarith.
rewrite Rmult_comm; apply Rmult_le_compat_r; auto with real zarith.
simpl; ring_simplify (2*1)%R; apply Rle_trans with 4%R; auto with real.
apply Rle_trans with (4+1)%R; auto with real.
ring_simplify (Fexp y-Fexp y)%Z; simpl; auto with zarith.
unfold Zpower_nat; simpl; auto with zarith.
Qed.

Theorem AddOddEven_can: forall (x y f1 f2:float) (z:R),
   (5*(Rabs y) <= Rabs x)%R ->
    (5*(firstNormalPos radix bo p) <= Rabs x)%R ->
   Fcanonic radix bo y ->(Fcanonic radix bo x) ->
   (To_Odd bo radix p z y) ->
   (EvenClosest bo radix p (x+y)%R f1) ->
   (EvenClosest bo radix p (x+z)%R f2) ->
       (FtoRradix f1=f2)%R.
intros.
case (Rle_or_lt 0%R x).
intros T; case T; intros H5'.
apply AddOddEven_aux with x y z; auto.
rewrite <- (Rabs_right x); auto with real.
rewrite <- (Rabs_right x); auto with real.
absurd (5 * firstNormalPos radix bo p <= Rabs x)%R; auto.
apply Rlt_not_le; rewrite <- H5'.
rewrite Rabs_R0.
unfold FtoRradix, FtoR, firstNormalPos, nNormMin; simpl.
repeat apply Rmult_lt_0_compat; auto with real zarith.
apply Rlt_le_trans with (4+1)%R; auto with real.
apply Rle_lt_trans with 4%R; auto with real.
apply Rle_trans with 2%R; auto with real.
intros H5'.
apply Rmult_eq_reg_l with (-1)%R; auto with real; ring_simplify.
unfold FtoRradix; repeat rewrite <- Fopp_correct; fold FtoRradix.
apply AddOddEven_aux with (Fopp x) (Fopp y) (-z)%R.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix.
rewrite Rabs_Ropp; rewrite <- (Rabs_left x); auto with real.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix; auto with real.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix; auto with real.
rewrite <- (Rabs_left x); auto with real.
apply FcanonicFopp; auto.
apply FcanonicFopp; auto.
generalize To_OddSymmetricP; unfold SymmetricP; intros T; apply T; auto.
replace (Fopp x + Fopp y)%R with (-(x+y))%R.
generalize EvenClosestSymmetric; unfold SymmetricP; intros T; apply T; auto.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix; auto with real.
replace (Fopp x + -z)%R with (-(x+z))%R.
generalize EvenClosestSymmetric; unfold SymmetricP; intros T; apply T; auto.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix; auto with real.
Qed.

Theorem AddOddEven: forall (x y f1 f2:float) (z:R),
  (Fbounded bo x) ->
   (5*(Rabs y) <= Rabs x)%R ->
    (5*(firstNormalPos radix bo p) <= Rabs x)%R ->
   (To_Odd bo radix p z y) ->
   (EvenClosest bo radix p (x+y)%R f1) ->
   (EvenClosest bo radix p (x+z)%R f2) ->
       (FtoRradix f1=f2)%R.
intros.
apply AddOddEven_can with (Fnormalize radix bo p x) (Fnormalize radix bo p y) z.
unfold FtoRradix; repeat rewrite FnormalizeCorrect; auto with real zarith.
unfold FtoRradix; rewrite FnormalizeCorrect; auto with real zarith.
apply FnormalizeCanonic; auto with zarith; elim H2; auto.
apply FnormalizeCanonic; auto with zarith.
apply To_OddCompatible with (4:=H2); auto with zarith.
rewrite FnormalizeCorrect; auto with real zarith.
apply FnormalizeBounded; auto with zarith; elim H2; auto.
unfold FtoRradix; repeat rewrite FnormalizeCorrect; auto with real zarith.
unfold FtoRradix; rewrite FnormalizeCorrect; auto with real zarith.
Qed.

Theorem AddOddEven2: forall (x y f1 f2:float) (z:R),
   (3 < p) ->
   (6*(Rabs z) <= Rabs x)%R ->
    (5*(firstNormalPos radix bo p) <= Rabs x)%R ->
   Fcanonic radix bo y ->(Fcanonic radix bo x) ->
   (To_Odd bo radix p z y) ->
   (EvenClosest bo radix p (x+y)%R f1) ->
   (EvenClosest bo radix p (x+z)%R f2) ->
       (FtoRradix f1=f2)%R.
intros.
apply AddOddEven_can with x y z; auto.
case H2; intros.
apply Rle_trans with (2:=H0).
apply Rplus_le_reg_l with (Rabs y-6*Rabs z)%R.
apply Rle_trans with (6*(Rabs y -Rabs z))%R;[right; ring|idtac].
assert (0 < 6)%R; auto with real.
apply Rlt_le_trans with 2%R; auto with real.
apply Rle_trans with 4%R; auto with real.
apply Rmult_le_reg_l with (/6)%R; auto with real.
apply Rle_trans with (Rabs y - Rabs z)%R;[right; field; auto with real|idtac].
apply Rle_trans with (Rabs (y-z)); [apply Rabs_triang_inv|idtac].
rewrite <- Rabs_Ropp.
replace (-(y-z))%R with (z-y)%R;[idtac|ring].
apply Rle_trans with (Fulp bo radix p y).
apply Rlt_le; unfold FtoRradix.
apply RoundedModeUlp with (To_Odd bo radix p); auto with zarith.
apply To_OddRoundedModeP; auto with zarith.
apply Rle_trans with (Rabs y * powerRZ radix (Zsucc (- p)))%R.
unfold FtoRradix; apply FulpLe2; auto with zarith.
elim H7; auto.
rewrite FcanonicFnormalizeEq; auto with zarith.
apply Rle_trans with ((Rabs y)*/6)%R;[idtac|right; ring].
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with (powerRZ radix (Zsucc (-4))); auto with real zarith.
apply Rle_powerRZ; auto with zarith real; unfold Zsucc; auto with zarith.
unfold Zsucc; simpl.
apply Rle_Rinv; auto with real.
apply Rle_trans with (6+1)%R; auto with real.
apply Rle_trans with (6+2)%R; auto with real.
right; ring.
apply Rle_trans with (2:=H1).
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with 2%R; auto with real.
apply Rle_trans with 4%R; auto with real.
apply Rle_trans with (4+1)%R; auto with real.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith; apply Rlt_le.
apply FsubnormalLtFirstNormalPos; auto with zarith.
apply FsubnormFabs; auto with zarith.
rewrite Fabs_correct; auto with real zarith.
Qed.

End Sec1.

Section Sec2.

Variable bo : Fbound.
Let radix := 2%Z.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Variable p : nat.

Hypotheses pGreaterThanOne : (lt (S O) p).
Hypotheses pGivesBound : (Zpos (vNum bo)) = (Zpower_nat radix p).
Hypotheses pGe : (5 <= p).

Variable a b c uh ul th tl v z:float.

Hypothesis Fa : Fbounded bo a.
Hypothesis Fb : Fbounded bo b.
Hypothesis Fc : Fbounded bo c.
Hypothesis Fuh: Fbounded bo uh.
Hypothesis Ful: Fbounded bo ul.
Hypothesis Fth: Fbounded bo th.
Hypothesis Ftl: Fbounded bo tl.
Hypothesis Fv : Fbounded bo v.
Hypothesis Fz : Fbounded bo z.
Hypothesis Cth: Fcanonic radix bo th.
Hypothesis Cuh: Fcanonic radix bo uh.
Hypothesis Ctl: Fcanonic radix bo tl.
Hypothesis Cul: Fcanonic radix bo ul.

Hypothesis uhDef: (Closest bo radix (a*b)%R uh).
Hypothesis ulDef: (FtoRradix ul=a*b-uh)%R.
Hypothesis thDef: (Closest bo radix (c+uh)%R th).
Hypothesis tlDef: (FtoRradix tl=c+uh-th)%R.
Hypothesis vDef: (To_Odd bo radix p (tl+ul)%R v).
Hypothesis zDef: (EvenClosest bo radix p (th+v)%R z).

Theorem FmaEmulAux: (EvenClosest bo radix p (a*b+c)%R z).
case (Req_dec v (tl+ul)); intros Eq1.
replace (a*b+c)%R with (th+v)%R; auto with real zarith.
rewrite Eq1; rewrite ulDef; rewrite tlDef; ring.
generalize EvenClosestTotal; unfold TotalP.
intros T; elim T with bo radix p (a*b+c)%R; auto with zarith.
clear T; intros z' Hz'.
apply EvenClosestCompatible with (4:=Hz'); auto with zarith.
apply sym_eq.
case (Rle_or_lt (5 *(firstNormalPos 2 bo p)) (Rabs (th)))%R; intros K1.
apply AddOddEven with bo p th v (tl+ul)%R; auto with zarith real.
fold radix; fold FtoRradix.
assert (0 < 5)%R; auto with real.
replace 5%R with (INR 5); auto with real zarith.
simpl; ring.
apply Rmult_le_reg_l with (/5)%R; auto with real.
apply Rle_trans with (Rabs v);[right; field; auto with real|idtac].
apply Rle_trans with (2*powerRZ radix (Fexp th))%R.
apply Rle_trans with (Float 2%Z (Fexp th)).
unfold FtoRradix.
apply RoundAbsMonotoner with (precision:=p) (b:=bo) (P:=To_Odd bo radix p) (p:=(tl+ul)%R);
     auto with zarith real.
apply To_OddRoundedModeP; auto with zarith.
split; simpl; auto with zarith.
rewrite pGivesBound; unfold radix; auto with zarith.
apply Zle_lt_trans with (Zpower_nat 2 1); auto with zarith.
elim Fth; auto.
apply Rle_trans with (1:=Rabs_triang tl ul).
apply Rle_trans with (powerRZ radix (Fexp th)+powerRZ radix (Fexp th))%R.
apply Rplus_le_compat.
apply Rle_trans with (Fulp bo radix p th); [rewrite tlDef|idtac].
unfold FtoRradix; apply Rlt_le; apply RoundedModeUlp with (P:=(Closest bo radix)); auto with zarith.
apply ClosestRoundedModeP with p; auto with zarith.
rewrite CanonicFulp; auto with zarith.
unfold FtoR; simpl; right; ring.
apply Rle_trans with (powerRZ radix (Fexp uh -1)).
apply Rmult_le_reg_l with (INR 2); auto with zarith real.
apply Rle_trans with (Fulp bo radix p uh).
rewrite ulDef; unfold FtoRradix; apply ClosestUlp; auto with zarith.
rewrite CanonicFulp; auto with zarith.
replace (INR 2) with (powerRZ radix 1).
rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (1 + (Fexp uh - 1))%Z; unfold FtoR; simpl; right; ring.
simpl; ring.
apply Rle_powerRZ; auto with zarith real.
case (Zle_or_lt (Fexp uh-1) (Fexp th)); auto with zarith.
intros A.
assert (Fexp th <= Fexp uh - 2)%Z; auto with zarith.
clear A; absurd (FtoRradix tl=0)%R.
Contradict Eq1.
rewrite Eq1; ring_simplify.
unfold FtoRradix; apply sym_eq.
apply RoundedModeProjectorIdemEq with bo p (To_Odd bo radix p); auto with zarith.
apply To_OddRoundedModeP; auto with zarith.
replace (FtoR radix ul) with (tl+ul)%R; auto with real.
rewrite Eq1; auto with real.
rewrite tlDef.
cut (FtoRradix th=c+uh)%R; auto with real.
case (Zle_or_lt (Fexp uh) (Fexp c)); intros.
unfold FtoRradix; apply plusExact1 with bo p; auto with zarith.
rewrite Zmin_le2; auto with zarith.
unfold FtoRradix; apply plusExact1 with bo p; auto with zarith.
rewrite Zmin_le1; auto with zarith.
case (Zle_or_lt (Fexp uh-1) (Fexp c)); intros I1.
auto with zarith.
cut (Fexp c <= Fexp uh-2)%Z; auto with zarith.
clear H1 I1; intros I.
absurd (Fexp uh-1 <= Fexp th)%Z; auto with zarith.
apply Zle_trans with (Fexp (Float (nNormMin radix p) (Fexp uh -1))).
simpl; auto with zarith.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
apply Zle_trans with (Fexp th); auto with zarith.
elim Fth; auto.
rewrite <- Fabs_correct; auto with zarith.
replace (Fabs (Float (nNormMin radix p) (Fexp uh - 1))) with
   (Float (nNormMin radix p) (Fexp uh - 1)).
apply RoundAbsMonotonel with (precision:=p) (b:=bo) (P:=Closest bo radix) (p:=(c+uh)%R);
     auto with zarith real.
apply ClosestRoundedModeP with p; auto with zarith.
assert (Fnormal radix bo (Float (nNormMin radix p) (Fexp uh - 1))).
apply FnormalNnormMin; auto with zarith.
apply Zle_trans with (Fexp th); auto with zarith; elim Fth; auto.
elim H1; auto.
apply Rle_trans with (powerRZ radix (p-2+Fexp uh)).
unfold FtoR; simpl; unfold nNormMin; rewrite Zpower_nat_Z_powerRZ.
rewrite <- powerRZ_add; auto with zarith real.
replace (pred p + (Fexp uh - 1))%Z with (p - 2 + Fexp uh)%Z; auto with real.
rewrite inj_pred; auto with zarith; unfold Zpred; ring.
apply Rle_trans with (powerRZ radix (p - 1 + Fexp uh) - powerRZ radix (p - 2 + Fexp uh))%R.
apply Rplus_le_reg_l with (powerRZ radix (p - 2 + Fexp uh)).
apply Rle_trans with (powerRZ radix (p - 1 + Fexp uh));[idtac|right; ring].
apply Rle_trans with (2*(powerRZ radix (p - 2 + Fexp uh)))%R;[right; ring|idtac].
replace 2%R with (powerRZ radix 1);[rewrite <- powerRZ_add|simpl]; auto with real zarith.
replace (1 + (p - 2 + Fexp uh))%Z with (p - 1 + Fexp uh)%Z; auto with real; ring.
apply Rle_trans with (Rabs uh-Rabs c)%R.
unfold Rminus; apply Rplus_le_compat.
case Cuh; intros.
elim H1; intros H2 H3.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
rewrite powerRZ_add; auto with real zarith.
unfold FtoR, Fabs; simpl.
apply Rmult_le_compat_r; auto with real zarith.
apply Rmult_le_reg_l with radix; auto with real zarith.
apply Rle_trans with (IZR (Zpos (vNum bo))).
rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ.
unfold Zminus; rewrite powerRZ_add; auto with real zarith; simpl; right.
field; ring_simplify (2*1)%R; auto with real zarith.
apply Rle_trans with (IZR (Zabs (radix * Fnum uh))); auto with real zarith.
rewrite Zabs_Zmult; rewrite mult_IZR; repeat rewrite <- Rabs_Zabs.
rewrite Rabs_right; auto with real zarith.
apply Rle_ge; auto with real zarith.
elim H1; intros H2 H3.
elim H3; intros H4 H5.
absurd (Fexp c <= (- dExp bo) - 2)%Z; auto with zarith.
elim Fc; auto with zarith.
apply Ropp_le_contravar.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
apply Rlt_le; apply Rlt_le_trans with (FtoR radix (Float (Zpos (vNum bo)) (Fexp uh - 2)))%R.
apply maxMax;auto with zarith.
right; unfold FtoR; rewrite pGivesBound; simpl; rewrite Zpower_nat_Z_powerRZ.
rewrite <- powerRZ_add; auto with real zarith.
replace (p + (Fexp uh - 2))%Z with (p - 2 + Fexp uh)%Z; auto with real zarith.
replace (c+uh)%R with (uh - (-c))%R;[idtac|ring].
rewrite <- (Rabs_Ropp c); apply Rabs_triang_inv.
unfold Fabs; simpl.
rewrite Zabs_eq; auto with zarith float.
apply Zlt_le_weak; apply nNormPos; auto with zarith.
unfold FtoR; simpl; right; ring.
unfold FtoRradix, FtoR; simpl; right; ring.
apply Rmult_le_reg_l with 5%R; auto with real.
apply Rle_trans with (10* powerRZ radix (Fexp th))%R;[right; ring|idtac].
apply Rle_trans with (Rabs th);[idtac|right; field; auto with real].
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold Fabs, FtoR; simpl; apply Rmult_le_compat_r; auto with real zarith.
replace 10%R with (IZR 10); auto with zarith real.
apply Rle_IZR.
2: simpl; auto with zarith real; ring.
elim Cth; intros H'.
elim H'; intros H1 H2.
apply Zmult_le_reg_r with radix; auto with zarith.
apply Zlt_gt; auto with zarith.
apply Zle_trans with (Zpos (vNum bo)).
rewrite pGivesBound.
apply Zle_trans with (Zpower_nat radix 5); auto with zarith.
apply Zle_trans with (1:=H2); rewrite Zabs_Zmult; auto with zarith.
absurd (Rabs th < firstNormalPos 2 bo p)%R.
apply Rle_not_lt.
apply Rle_trans with (2:=K1).
apply Rle_trans with (1*(firstNormalPos 2 bo p))%R;[right; ring|idtac].
apply Rmult_le_compat_r; auto with real zarith.
unfold firstNormalPos, FtoRradix; apply LeFnumZERO; auto with zarith.
simpl; apply Zlt_le_weak; apply nNormPos; auto with zarith.
apply Rle_trans with 2%R; auto with real.
apply Rle_trans with 4%R; auto with real.
apply Rle_trans with (4+1)%R; auto with real.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
apply FsubnormalLtFirstNormalPos ; auto with zarith.
apply FsubnormFabs; auto with zarith.
rewrite Fabs_correct; auto with real zarith.
replace (FtoR 2 th + (tl + ul))%R with (a*b+c)%R; auto.
fold radix; fold FtoRradix; rewrite tlDef; rewrite ulDef; ring.
assert (Fsubnormal radix bo tl).
case Ctl; auto; intros.
absurd (firstNormalPos 2 bo p <= Rabs tl)%R.
apply Rlt_not_le.
apply Rlt_le_trans with (Fulp bo radix p th).
rewrite tlDef; unfold FtoRradix.
apply RoundedModeUlp with (Closest bo radix); auto with zarith.
apply ClosestRoundedModeP with p; auto with zarith.
rewrite CanonicFulp; auto with zarith.
unfold firstNormalPos, FtoRradix, FtoR; simpl.
unfold nNormMin; rewrite Zpower_nat_Z_powerRZ.
ring_simplify (1 * powerRZ 2 (Fexp th))%R; rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
apply Zle_trans with (Fexp (Float (nNormMin radix p) (-dExp bo+3))).
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
apply Rlt_le; apply Rlt_le_trans with (1:=K1).
rewrite <- Fabs_correct; auto with zarith;unfold firstNormalPos.
unfold Fabs, FtoRradix, FtoR; simpl.
rewrite Zabs_eq; auto with zarith float.
rewrite powerRZ_add; auto with zarith real.
apply Rle_trans with ((powerRZ 2 3) * (nNormMin 2 p * powerRZ 2 (- dExp bo)))%R.
apply Rmult_le_compat_r; auto with real zarith.
apply Rmult_le_pos; auto with real zarith.
generalize nNormPos; auto with real zarith.
simpl; auto with real.
apply Rle_trans with (5+3)%R; auto with real.
apply Rle_trans with (5+0)%R; auto with real.
assert (0 <= 3)%R; auto with real.
apply Rle_trans with 2%R; auto with real.
right; ring.
right; simpl;unfold radix;ring.
apply Zlt_le_weak; apply nNormPos; auto with real zarith.
simpl; rewrite inj_pred; auto with zarith; unfold Zpred; auto with zarith.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
apply FnormalLtFirstNormalPos; auto with zarith.
apply FnormalFabs; auto with zarith.
rewrite Fabs_correct; auto with zarith real.
case Cul; intros.
absurd (FtoRradix tl=0)%R.
Contradict Eq1.
rewrite Eq1; ring_simplify.
unfold FtoRradix; apply sym_eq.
apply RoundedModeProjectorIdemEq with bo p (To_Odd bo radix p); auto with zarith.
apply To_OddRoundedModeP; auto with zarith.
replace (FtoR radix ul) with (tl+ul)%R; auto with real.
rewrite Eq1; auto with real.
rewrite tlDef.
cut (FtoRradix th=uh+c)%R; auto with real.
intros A; rewrite A; ring.
unfold FtoRradix; apply plusExact2 with bo p; auto with zarith real.
rewrite Rplus_comm; auto with real.
cut (Fnormal radix bo th);[intros H1|idtac].
apply Zlt_powerRZ with radix; auto with zarith real.
apply Rle_lt_trans with (Rabs th*powerRZ radix (1-p))%R.
apply Rmult_le_reg_l with (powerRZ radix (p-1)); auto with real zarith.
apply Rle_trans with (Rabs th).
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold Fabs, FtoR; simpl.
apply Rmult_le_compat_r; auto with real zarith.
elim H1; intros.
apply Rmult_le_reg_l with (IZR radix); auto with zarith real.
apply Rle_trans with (Zpos (vNum bo));[rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ|idtac].
unfold Zminus; rewrite powerRZ_add; auto with real zarith; simpl; right; field.
ring_simplify (2*1)%R; auto with real.
apply Rle_trans with (IZR (Zabs (radix * Fnum th))); auto with zarith real.
rewrite Zabs_Zmult; rewrite Zabs_eq; auto with zarith; rewrite mult_IZR; auto with real.
right; apply trans_eq with (Rabs th * (powerRZ radix (1 - p)* powerRZ radix (p - 1)))%R;[idtac|ring].
rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (1 - p + (p - 1))%Z; simpl; ring.
apply Rlt_le_trans with ((5 * firstNormalPos 2 bo p)*powerRZ radix (1 - p))%R; auto with real zarith.
apply Rle_trans with (firstNormalPos 2 bo p).
apply Rle_trans with ((5*powerRZ radix (1 - p))* firstNormalPos 2 bo p)%R;[right; ring|idtac].
apply Rle_trans with (1* firstNormalPos 2 bo p)%R;[idtac|right; ring].
apply Rmult_le_compat_r; auto with real zarith.
unfold FtoRradix; apply LeFnumZERO; auto with zarith.
unfold firstNormalPos; simpl; auto with zarith.
unfold nNormMin; auto with zarith.
apply Rle_trans with (powerRZ radix 3 * powerRZ radix (1 - p))%R.
apply Rmult_le_compat_r; auto with real zarith; simpl; auto with real.
apply Rle_trans with (5+3)%R;[idtac|right; ring].
apply Rle_trans with (5+2)%R; auto with real.
apply Rle_trans with (5+1)%R; auto with real.
rewrite <- powerRZ_add; auto with real zarith.
apply Rle_trans with (powerRZ radix 0); auto with real zarith.
apply Rle_trans with (Fabs ul).
unfold FtoRradix; apply FnormalLtFirstNormalPos; auto with zarith.
apply FnormalFabs; auto with zarith.
rewrite Fabs_correct; auto with real zarith.
apply Rmult_le_reg_l with (INR 2); auto with real zarith.
unfold FtoRradix; rewrite Fabs_correct; auto with zarith.
fold FtoRradix; rewrite ulDef; apply Rle_trans with (Fulp bo radix p uh).
unfold FtoRradix; apply ClosestUlp; auto with zarith.
rewrite CanonicFulp; auto with zarith.
right; unfold FtoR; simpl.
unfold Zpred, Zminus; rewrite powerRZ_add; auto with real zarith.
simpl; field.
ring_simplify (2*1)%R; auto with real.
case Cth; auto.
intros I; assert (FtoRradix tl=0)%R.
rewrite tlDef.
assert (FtoRradix th=c+uh)%R; auto with real.
unfold FtoRradix; apply plusExact1 with bo p; auto with zarith.
elim Fc; elim Fuh; intros.
elim I; intros I1 I2; elim I2; intros.
rewrite H5; apply Zmin_Zle; auto with zarith.
absurd (FtoRradix v=tl+ul)%R; auto with real.
rewrite H1; ring_simplify.
unfold FtoRradix; apply sym_eq.
apply RoundedModeProjectorIdemEq with bo p (To_Odd bo radix p); auto with zarith.
apply To_OddRoundedModeP; auto with zarith.
replace (FtoR radix ul) with (tl+ul)%R; auto with real.
rewrite H1; fold FtoRradix; ring.
absurd (FtoRradix v = tl + ul)%R; auto with real.
unfold FtoRradix; apply plusExactSub with bo p (To_Odd bo radix p); auto with zarith.
apply To_OddRoundedModeP; auto with zarith.
Qed.

End Sec2.

Section Sec3.

Variable bo : Fbound.
Let radix := 2%Z.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Variable p : nat.

Hypotheses pGivesBound : (Zpos (vNum bo)) = (Zpower_nat radix p).
Hypotheses pGe : (5 <= p).

Variable a b c uh ul th tl v z:float.

Hypothesis Fa : Fbounded bo a.
Hypothesis Fb : Fbounded bo b.
Hypothesis Fc : Fbounded bo c.
Hypothesis Ful: Fbounded bo ul.

Hypothesis uhDef: (Closest bo radix (a*b)%R uh).
Hypothesis ulDef: (FtoRradix ul=a*b-uh)%R.
Hypothesis thDef: (Closest bo radix (c+uh)%R th).
Hypothesis tlDef: (FtoRradix tl=c+uh-th)%R.
Hypothesis vDef: (To_Odd bo radix p (tl+ul)%R v).
Hypothesis zDef: (EvenClosest bo radix p (th+v)%R z).

Theorem FmaEmul: (EvenClosest bo radix p (a*b+c)%R z).
elim errorBoundedPlus with bo radix p c uh th; auto with zarith.
2: elim uhDef; auto.
intros tl' T; elim T; intros H1 T'; elim T'; intros H2 H3; clear T T'.
apply FmaEmulAux with (Fnormalize radix bo p uh)
   (Fnormalize radix bo p ul) (Fnormalize radix bo p th)
   (Fnormalize radix bo p tl') v; auto with zarith.
apply FnormalizeBounded; elim uhDef; auto with zarith.
apply FnormalizeBounded; auto with zarith.
apply FnormalizeBounded; elim thDef; auto with zarith.
elim zDef; intros A1 A2; elim A1; auto.
apply FnormalizeCanonic; auto with zarith; elim thDef; auto.
apply FnormalizeCanonic; auto with zarith; elim uhDef; auto.
apply FnormalizeCanonic; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
apply ClosestCompatible with (1:=uhDef); auto with real.
rewrite FnormalizeCorrect; auto with real zarith.
apply FnormalizeBounded; elim uhDef; auto with zarith.
repeat rewrite FnormalizeCorrect; auto with real zarith.
apply ClosestCompatible with (1:=thDef); auto with real.
rewrite FnormalizeCorrect; auto with real zarith.
rewrite FnormalizeCorrect; auto with real zarith.
apply FnormalizeBounded; elim thDef; auto with zarith.
repeat rewrite FnormalizeCorrect; auto with real zarith.
repeat rewrite FnormalizeCorrect; auto with real zarith.
rewrite H1; fold FtoRradix; rewrite <- tlDef; auto.
repeat rewrite FnormalizeCorrect; auto with real zarith.
Qed.

End Sec3.

Section Sec4.
Variables b be : Fbound.
Variables p k : nat.
Variables y z v: float.
Variables x : R.

Let radix := 2%Z.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.

Theorem Zpos_eq_eq: forall (a b:positive),
   (Zpos a=Zpos b) -> a=b.
intros f.
induction f; intros g.
elim g; intros; auto with zarith.
replace p0 with f; auto.
apply IHf; auto with zarith.
repeat rewrite Zpos_xI in H0; auto with zarith.
rewrite Zpos_xI in H0.
rewrite (Zpos_xO p0) in H0; auto with zarith.
absurd (2 * Zpos f + 1 = 2 * Zpos p0)%Z; auto with zarith.
absurd (Zpos (xI f) = 1)%Z; auto with zarith.
elim g; intros; auto with zarith.
rewrite Zpos_xI in H0.
rewrite (Zpos_xO f) in H0; auto with zarith.
absurd (2 * Zpos f = 2 * Zpos p0 +1)%Z; auto with zarith.
replace p0 with f; auto.
apply IHf; auto with zarith.
rewrite (Zpos_xO f) in H0; rewrite (Zpos_xO p0) in H0; auto with zarith.
absurd (Zpos (xO f) = 1)%Z; auto with zarith.
elim g; intros; auto with zarith.
absurd (1 = Zpos (xI p0))%Z; auto with zarith.
absurd (1 = Zpos (xO p0))%Z; auto with zarith.
Qed.

Hypotheses pGreaterThanOne : (lt (S O) p).
Hypotheses kGreaterThanOne : (le O k).
Hypotheses pGivesBound : (Zpos (vNum b)) = (Zpower_nat radix p).
Hypotheses pkGivesBounde : (Zpos (vNum be)) = (Zpower_nat radix (plus p k)).

Hypothesis Cy: (Fcanonic radix be y).
Hypothesis Cz: (Fcanonic radix b z).

Hypotheses ydef : (To_Odd be radix (plus p k) x y).
Hypotheses zdef : (To_Odd b radix p y z).
Hypotheses vdef : (To_Odd b radix p x v).

Hypotheses rangeext: (-(dExp be) = ( -k-(dExp b)))%Z.

Theorem FevenMakesFNeven: forall b:Fbound, forall p:nat, forall f g:float,
   Zpos (vNum b) = Zpower_nat radix p -> (0 < p) ->
    Fbounded b g -> Fbounded b f ->
    Feven g -> FtoRradix g=f -> FNeven b radix p f.
intros.
unfold FNeven.
replace (Fnormalize radix b0 p0 f) with (Fnormalize radix b0 p0 g).
elim H2; intros n Hn.
unfold Fnormalize, Feven.
case (Z_zerop (Fnum g)); intros.
simpl; unfold Even; exists 0%Z; auto with zarith.
unfold Fshift; simpl.
apply EvenMult1; auto.
apply FcanonicUnique with radix b0 p0; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
repeat rewrite FnormalizeCorrect; auto with real zarith.
Qed.

Theorem To_Odd_Odd_is_Odd: ((FtoRradix v)=(FtoRradix z))%R.
case (Zle_lt_or_eq 0 k); auto with zarith; intros J1.
generalize To_OddUniqueP; unfold UniqueP; intros T.
unfold FtoRradix; apply sym_eq; apply T with b p x; auto with zarith.
clear T; split; auto.
elim zdef; auto.
elim zdef; intros; elim ydef; intros.
case H0; case H2; clear H H0 H1 H2; fold FtoRradix; intros.
left; rewrite H; auto with real.
case Cy; intros.
absurd (FNeven be radix (p+k) y).
apply FnOddNEven; elim H; auto.
apply FevenMakesFNeven with (Float (Fnum z*Zpower_nat radix k) (Fexp z-k));
   auto with zarith.
elim zdef; intros T1 T2; elim T1; clear T1 T2; intros.
split; simpl; auto with zarith.
rewrite pkGivesBounde; rewrite Zpower_nat_is_exp.
rewrite Zabs_Zmult; rewrite (Zabs_eq (Zpower_nat radix k)); auto with zarith.
apply Zmult_lt_compat_r; auto with zarith.
elim H1; auto.
unfold Feven; simpl.
apply EvenMult2; auto.
unfold Even; exists (Zpower_nat radix (pred k)).
pattern k at 1; replace k with (1+pred k); auto with zarith.
rewrite H0; unfold FtoRradix, FtoR; simpl.
rewrite mult_IZR; rewrite Zpower_nat_Z_powerRZ.
rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (k+(Fexp z-k))%Z; auto with real.
absurd (FNeven be radix (p+k) y).
apply FnOddNEven; elim H; auto.
unfold FNeven; rewrite FcanonicFnormalizeEq; auto with zarith.
unfold Feven.
cut (0 < Fexp z+dExp be)%Z;[intros J2|idtac].
replace (Fnum y) with
   ((Fnum z)*Zpower_nat radix (Zabs_nat (Fexp z+dExp be)))%Z.
apply EvenMult2.
replace (Zabs_nat (Fexp z + dExp be)) with
   (1+Zabs_nat (-1+Fexp z + dExp be)).
rewrite Zpower_nat_is_exp.
apply EvenMult1; simpl; unfold Even; auto with zarith.
unfold Zpower_nat; exists 1%Z; simpl; ring.
assert (1 + Zabs_nat (-1 + Fexp z + dExp be) = Zabs_nat (Fexp z + dExp be))%Z;
  auto with zarith.
repeat rewrite <- Zabs_absolu.
repeat rewrite Zabs_eq; auto with zarith.
apply eq_IZR; rewrite mult_IZR.
rewrite Zpower_nat_powerRZ_absolu; auto with zarith.
apply trans_eq with (z*powerRZ radix (dExp be))%R.
repeat rewrite powerRZ_add; auto with real zarith.
unfold FtoRradix, FtoR; ring.
rewrite <- H0; elim H1; intros T1 T2; elim T2; intros J3 T4; clear T1 T2 T4.
unfold FtoRradix, FtoR; rewrite J3.
rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (- dExp be + dExp be)%Z; simpl; auto with real.
elim zdef; intros T1 T2; elim T1; intros; auto with zarith.
elim H0; intros; rewrite H.
right; split; auto.
elim H0 ; elim H; clear H0 H; intros.
right; split; auto.
cut (MinOrMax radix b x z); auto.
apply DblRndStable with be (p+k) p y; auto with zarith.
rewrite inj_plus; ring_simplify (p+k-p)%Z; auto with zarith.
elim ydef; auto.
elim zdef; auto.
apply trans_eq with (FtoRradix y).
generalize To_OddUniqueP; unfold UniqueP; intros T.
unfold FtoRradix; apply sym_eq; apply T with b p x; auto with zarith.
replace p with (p+k); auto with zarith.
replace b with be; auto.
clear T; destruct b; destruct be; auto.
replace vNum0 with vNum.
replace dExp0 with dExp; auto with zarith.
generalize rangeext; simpl; rewrite <- J1; auto with zarith.
intros; cut (Z_of_N dExp=dExp0)%Z; auto with zarith.
unfold Z_of_N; case (dExp);case (dExp0); auto with zarith.
intros; absurd (0%Z = Zpos p0)%Z; auto with zarith.
intros; absurd (Zpos p0 = 0%Z)%Z; auto with zarith.
intros; auto with zarith.
replace p0 with p1; auto with zarith.
apply Zpos_eq_eq; auto with zarith.
generalize pGivesBound; generalize pkGivesBounde; simpl; auto with zarith.
replace (p+k) with p; auto with zarith.
intros; apply Zpos_eq_eq; auto with zarith.
unfold FtoRradix; apply RoundedModeProjectorIdemEq with b p (To_Odd b radix p); auto with zarith.
apply To_OddRoundedModeP; auto with zarith.
elim ydef; intros.
clear H0; elim H; intros.
split; auto with zarith.
apply Zlt_le_trans with (1:=H0); rewrite pGivesBound ; rewrite pkGivesBounde;
    auto with zarith.
Qed.


End Sec4.

Section Sec5.

Variable bo : Fbound.
Let radix := 2%Z.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Variable p : nat.

Hypotheses pGreaterThanOne: (lt (S O) p).
Hypotheses pGivesBound : (Zpos (vNum bo)) = (Zpower_nat radix p).
Hypotheses dExpBig : (p <= dExp bo)%Z.

Theorem AddOddOdd_aux_aux: forall (x y:float),
      (2* (Rabs y) <= x)%R -> (0 < x)%R
   -> (2*(firstNormalPos radix bo p) <= x)%R
   -> (Fcanonic radix bo y) ->(Fcanonic radix bo x) ->
   (exists k:nat, exists be:Fbound, exists xy:float,
        (0 <= k) /\ (Zpos (vNum be)) = (Zpower_nat radix (p+k))
          /\ (- dExp be = -k - dExp bo)%Z
         /\ (FtoRradix xy =x+y)%R
         /\ (Fnormal radix be xy) /\ (Fexp xy=Fexp y)).
intros.
cut (forall k:nat, exists bb:Fbound,
           Zpos (vNum bb) = Zpower_nat radix k /\
          (- dExp bb = -k +p - dExp bo)%Z).
intros L1.
exists ((FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))))+1-p).
elim L1 with (1+FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y)))).
intros bb T; elim T; intros; clear T L1.
exists bb.
exists (Fplus radix x y).
cut (1 <= Zabs_nat (Fnum (Fplus radix x y)));[intros L1|idtac].
generalize (FNIMore radix); intros T; lapply T; auto with zarith; clear T; intros T.
lapply (T (Zabs_nat (Fnum (Fplus radix x y))) 1); auto with zarith.
clear T; intros T; lapply T; auto; clear T; intros L2.
cut (Zabs_nat (Fnum (Fplus radix x y)) <
      radix *
      (Zpower_nat radix (FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))))))%Z;
  [clear L2; intros L2| apply Zlt_le_trans with (1:=L2)].
2:apply Zmult_le_compat_l; simpl; auto with zarith.
generalize (FNILess radix); intros T; lapply T; auto with zarith; clear T; intros T.
lapply (T 1 (Zabs_nat (Fnum (Fplus radix x y)))); auto with zarith.
clear T; intros T; lapply T; auto; clear T; intros L3.
cut (Zpower_nat radix (FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))))
       <= Zabs_nat (Fnum (Fplus radix x y)))%Z;
  [clear L3; intros L3| apply Zle_trans with (2:=L3)].
2: simpl; auto with zarith.
cut (Fexp (Fplus radix x y) = Fexp y);[intros J1|idtac].
assert (p-2 < FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y)))).
case H2; intros J2.
apply Zpower_nat_anti_monotone_lt with radix; auto with zarith.
apply Zmult_lt_reg_r with radix; auto with zarith.
apply Zle_lt_trans with (Zabs_nat (Fnum (Fplus radix x y))) ; auto with zarith.
2: apply Zlt_le_trans with (1:=L2); auto with zarith.
apply Zle_Rle; rewrite mult_IZR.
apply Rmult_le_reg_l with (powerRZ radix (Fexp (Fplus radix x y))); auto with real zarith.
apply Rle_trans with (Rabs (x+y))%R.
rewrite J1; apply Rle_trans with (Rabs x -Rabs y)%R.
apply Rplus_le_reg_l with (Rabs y).
ring_simplify (Rabs y + (Rabs x - Rabs y))%R.
apply Rle_trans with (2*Rabs y)%R.
apply Rle_trans with ((Rabs y)+Rabs y)%R;[apply Rplus_le_compat_l|right; ring].
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith; unfold Fabs, FtoR.
simpl.
apply Rle_trans with ((powerRZ 2 (Fexp y)*(Zabs (Fnum y))))%R;
  [idtac|right; ring].
apply Rmult_le_compat_l; auto with real zarith.
elim J2; intros.
apply Rmult_le_reg_l with (IZR radix); auto with real zarith.
apply Rle_trans with (IZR (Zpower_nat radix p));[right|idtac].
pattern p at 2; replace p with (S (S (p-2))); auto with zarith.
rewrite Zpower_nat_S; rewrite Zpower_nat_S.
rewrite mult_IZR; rewrite mult_IZR; simpl; ring.
rewrite <- pGivesBound; rewrite Zabs_Zmult in H7.
rewrite Zabs_eq in H7; auto with real zarith.
apply Rle_trans with (IZR (radix * Zabs (Fnum y))); auto with real zarith.
rewrite mult_IZR; simpl; auto with zarith real.
rewrite Rabs_right with x; [idtac|apply Rle_ge];auto with real.
rewrite <- Rabs_Ropp with x.
apply Rle_trans with (Rabs (-x-y))%R.
apply Rabs_triang_inv.
replace (-x-y)%R with (-(x+y))%R; [rewrite Rabs_Ropp;auto with real|ring].
unfold FtoRradix; rewrite <- Fplus_correct; auto with zarith.
rewrite <- Fabs_correct; auto with zarith; unfold FtoR, Fabs; simpl; right; ring_simplify.
rewrite Zabs_absolu; ring.
apply Zpower_nat_anti_monotone_lt with radix; auto with zarith.
apply Zmult_lt_reg_r with radix; auto with zarith.
apply Zle_lt_trans with (Zabs_nat (Fnum (Fplus radix x y))) ; auto with zarith.
2: apply Zlt_le_trans with (1:=L2); auto with zarith.
apply Zle_Rle; rewrite mult_IZR.
apply Rmult_le_reg_l with (powerRZ radix (Fexp (Fplus radix x y))); auto with real zarith.
apply Rle_trans with (Rabs (x+y))%R.
rewrite J1; apply Rle_trans with (Rabs x -Rabs y)%R.
apply Rplus_le_reg_l with (Rabs y).
ring_simplify (Rabs y + (Rabs x - Rabs y))%R.
rewrite (Rabs_right x);[idtac| apply Rle_ge; auto with real].
apply Rle_trans with (2:=H1).
apply Rle_trans with (firstNormalPos radix bo p +firstNormalPos radix bo p)%R;
  [idtac|right; ring].
assert ((Fabs y) <= firstNormalPos radix bo p)%R.
apply Rlt_le; unfold FtoRradix.
apply FsubnormalLtFirstNormalPos; auto with zarith.
apply FsubnormFabs; auto with zarith.
rewrite Fabs_correct; auto with real zarith.
apply Rplus_le_compat.
unfold FtoRradix; rewrite <- Fabs_correct; auto with real zarith.
elim J2; intros T1 T2; elim T2; intros T3 T4; rewrite T3.
right; unfold firstNormalPos, nNormMin, FtoRradix, FtoR; simpl.
replace (pred p) with (S (p-2)); auto with zarith.
rewrite Zpower_nat_S; rewrite mult_IZR; simpl; ring.
rewrite <- Rabs_Ropp with x.
apply Rle_trans with (Rabs (-x-y))%R.
apply Rabs_triang_inv.
replace (-x-y)%R with (-(x+y))%R; [rewrite Rabs_Ropp;auto with real|ring].
unfold FtoRradix; rewrite <- Fplus_correct; auto with zarith.
rewrite <- Fabs_correct; auto with zarith; unfold FtoR, Fabs; simpl; right.
rewrite Zabs_absolu; ring.
split; auto with zarith.
split;[rewrite H4; auto with zarith|idtac].
split.
rewrite H5; auto with zarith.
rewrite inj_plus; auto with zarith.
replace (Z_of_nat (FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))) + 1 - p)) with
       ((FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))) + 1 - p))%Z; auto with zarith.
replace 1%Z with (Z_of_nat (S O))%Z; auto with zarith.
assert (p+(FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))) + 1 - p)%Z =
   (p+(FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))) + 1 - p)%nat))%Z; auto with zarith.
apply trans_eq with (Z_of_nat ((p + ((FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))) + 1) - p)))); auto with zarith.
rewrite <- le_plus_minus; auto with zarith.
rewrite inj_plus; auto with zarith.
simpl; ring.
rewrite inj_plus; auto with zarith.
split;[unfold FtoRradix; rewrite Fplus_correct; auto with real zarith|idtac].
split; auto.
split;[split|idtac].
rewrite Zabs_absolu; apply Zlt_le_trans with (1:=L2).
rewrite H4; rewrite Zpower_nat_is_exp; auto with zarith.
rewrite J1; apply Zle_trans with (-(dExp bo))%Z; auto with zarith.
rewrite H5; auto with zarith.
assert (- (1 + FNI radix 1 (Zabs_nat (Fnum (Fplus radix x y))))%nat + p <= 0)%Z; auto with zarith.
rewrite inj_plus; auto with zarith.
replace (Z_of_nat (S O)) with 1%Z; auto with zarith.
case H2; intros T; elim T; intros T1 T2; elim T1; auto.
rewrite H4; rewrite Zpower_nat_is_exp; auto with zarith.
rewrite Zabs_Zmult.
replace (Zpower_nat radix 1) with (Zabs radix); auto with zarith.
apply Zmult_le_compat_l; auto with zarith.
rewrite Zabs_absolu; auto.
unfold Fplus; simpl.
apply Zmin_le2.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
fold FtoRradix; apply Rle_trans with (1*Rabs y)%R;[right; ring|idtac].
apply Rle_trans with (2*Rabs y)%R;[apply Rmult_le_compat_r; auto with real|idtac].
apply Rle_trans with (1:=H); rewrite Rabs_right;[idtac|apply Rle_ge]; auto with real.
assert (1 <= Zabs_nat (Fnum (Fplus radix x y)))%Z; auto with zarith.
rewrite <- Zabs_absolu.
cut (0 < Fnum (Fplus radix x y))%Z; auto with zarith.
intros K; rewrite Zabs_eq; auto with zarith.
apply LtR0Fnum with radix; auto with zarith.
rewrite Fplus_correct; auto with zarith; fold FtoRradix.
apply Rplus_lt_reg_r with (-y)%R.
ring_simplify.
case (Req_dec 0 y); intros K.
rewrite <-K; ring_simplify (-0)%R; auto with real.
apply Rle_lt_trans with (Rabs (-y))%R; auto with real.
apply RRle_abs.
rewrite Rabs_Ropp; apply Rlt_le_trans with (2:=H).
apply Rle_lt_trans with (1*Rabs y)%R; auto with real.
apply Rmult_lt_compat_r; auto with real.
assert (0 <= Rabs y)%R; auto with real.
case H6; auto; intros K'.
absurd ( Rabs y=0)%R; auto.
apply Rabs_no_R0; auto.
intros k.
case (Zle_lt_or_eq 0 (k-p+dExp bo)); auto with zarith; intros.
exists (Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix k))))
    (Npos (P_of_succ_nat (pred (Zabs_nat (k-p+ (dExp bo))))))).
split; simpl.
apply trans_eq with
    (Z_of_nat
       (nat_of_P
          (P_of_succ_nat
             (pred (Zabs_nat (Zpower_nat radix k)))))); auto with zarith.
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
 auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
rewrite <- (S_pred (Zabs_nat (Zpower_nat radix (k))) 0);
 auto with arith zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
cut (0 < Zabs_nat (Zpower_nat radix k))%Z; auto with zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
cut (Zpos (P_of_succ_nat (pred (Zabs_nat (k - p + dExp bo))))
   = -(-k+p-dExp bo))%Z; auto with zarith.
intros V; apply trans_eq with (-( Zpos(P_of_succ_nat (pred (Zabs_nat (k - p + dExp bo))))))%Z;
  auto with zarith.
apply trans_eq with (k-p+dExp bo)%Z; auto with zarith.
apply trans_eq with
    (Z_of_nat
       (nat_of_P
          (P_of_succ_nat
             (pred (Zabs_nat (k-p+dExp bo)))))); auto with zarith.
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
 auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
rewrite <- (S_pred (Zabs_nat (k-p+dExp bo)) 0);
 auto with arith zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
cut (0 < Zabs_nat (k-p+dExp bo))%Z; auto with zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
exists (Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix k))))
    N0).
split; simpl.
apply trans_eq with
    (Z_of_nat
       (nat_of_P
          (P_of_succ_nat
             (pred (Zabs_nat (Zpower_nat radix k)))))); auto with zarith.
unfold Z_of_nat in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
 auto with zarith.
rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith zarith.
rewrite <- (S_pred (Zabs_nat (Zpower_nat radix (k))) 0);
 auto with arith zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
cut (0 < Zabs_nat (Zpower_nat radix k))%Z; auto with zarith.
rewrite <- Zabs_absolu; rewrite Zabs_eq; auto with zarith.
auto with zarith.
Qed.

Theorem AddOddOdd_aux: forall (x y f1 f2:float) (z:R),
   (2* (Rabs y) <= x)%R -> (0 < x)%R ->
   (2*(firstNormalPos radix bo p) <= x)%R ->
   (Fcanonic radix bo y) ->(Fcanonic radix bo x) ->
   (To_Odd bo radix p z y) ->
   (To_Odd bo radix p (x+y)%R f1) ->
   (To_Odd bo radix p (x+z)%R f2) ->
       (FtoRradix f1=f2)%R.
intros.
elim H4; intros.
case H8; clear H8; intros H8.
generalize To_OddUniqueP; unfold UniqueP; intros T.
unfold FtoRradix; apply T with bo p (x+z)%R; auto with zarith.
rewrite H8; auto with real.
elim (AddOddOdd_aux_aux x y); auto.
intros k T1; elim T1; intros be T2; elim T2; intros xy T3; clear T1 T2.
elim T3; intros H8' T4; elim T4; intros H9 T5; elim T5; clear T3 T4 T5.
intros H10 T6; elim T6; intros H11 T7; elim T7; intros; clear T6 T7.
apply sym_eq.
apply trans_eq with (FtoRradix (Fnormalize radix bo p f1)).
2: unfold FtoRradix; apply FnormalizeCorrect; auto with zarith.
cut (Fbounded bo f1);[intros Ff1|elim H5; intros T1 T2; elim T1; auto].
apply To_Odd_Odd_is_Odd with bo be p k xy (x+z)%R; auto.
left; auto.
apply FnormalizeCanonic; auto with zarith.
2: replace (FtoR 2 xy) with (x+y)%R; auto with real.
2: apply To_OddCompatible with (4:=H5); auto with real zarith.
2: apply sym_eq; apply FnormalizeCorrect; auto with zarith.
2: apply FnormalizeBounded; auto with zarith.
unfold To_Odd.
split;[elim H12; auto|idtac].
right.
cut (FNodd be 2 (p + k) xy);[intros Y|idtac].
split; auto.
elim H8; intros; case H14; intros.
clear H8 H14; elim H16; intros T1 T2; elim T2; clear T1 T2; intros.
left; split;[elim H12; auto|split].
fold radix; fold FtoRradix; rewrite H11; auto with real.
fold radix; intros f U1 U2.
rewrite <- FPredSuc with be radix (p+k) xy; auto with zarith.
2: left; auto.
rewrite <- FnormalizeCorrect with radix be (p+k) f; auto with zarith.
apply FPredProp; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
apply FSuccCanonic; auto with zarith; left; auto.
rewrite FnormalizeCorrect; auto with zarith.
apply Rle_lt_trans with (1:=U2).
apply Rplus_lt_reg_r with (-FtoRradix xy)%R.
apply Rle_lt_trans with (z-y)%R;[rewrite H11; right; ring|idtac].
apply Rlt_le_trans with (FtoRradix ( Float 1%nat (Fexp y))).
apply Rplus_lt_reg_r with (FtoRradix y).
apply Rle_lt_trans with z;[right; ring|idtac].
apply Rlt_le_trans with (FSucc bo radix p y).
case (Rle_or_lt (FSucc bo radix p y) z); auto; intros U3.
absurd ((FSucc bo radix p y <= y))%R.
apply Rlt_not_le.
unfold FtoRradix; apply FSuccLt; auto with zarith.
apply H14; auto.
apply FBoundedSuc; auto with zarith.
right; apply Rplus_eq_reg_l with (-y)%R.
apply trans_eq with (FtoRradix (Fminus radix (FSucc bo radix p y) y)).
unfold FtoRradix; rewrite Fminus_correct; auto with zarith; ring.
unfold FtoRradix; rewrite FSuccDiff1; auto with zarith.
ring.
case (Z_eq_dec (Fnum y) (-(nNormMin radix p))%Z); auto; intros K.
absurd (FNodd bo radix p y); auto.
unfold FNodd; rewrite FcanonicFnormalizeEq; auto with zarith.
unfold Fodd; apply EvenNOdd; rewrite K.
unfold Even, radix, nNormMin.
exists (-(Zpower_nat 2 (pred (pred p))))%Z.
apply trans_eq with (-(Zpower_nat 2 (1+(pred (pred p)))))%Z; auto with zarith.
replace (1+(pred (pred p))) with (pred p); auto with zarith.
rewrite Zpower_nat_is_exp; auto with zarith.
replace (Zpower_nat 2 1) with 2%Z; auto with zarith.
right; apply trans_eq with (FtoRradix (Fminus radix (FSucc be radix (p+k) xy) xy)).
unfold FtoRradix; rewrite FSuccDiff1; auto with zarith real.
rewrite H13; auto with real.
case (Z_eq_dec (Fnum xy) (-(nNormMin radix (p+k)))%Z); auto; intros K.
absurd (FNodd be radix (p+k) xy); auto.
unfold FNodd; rewrite FcanonicFnormalizeEq; auto with zarith.
2: left; auto.
unfold Fodd; apply EvenNOdd; rewrite K.
unfold Even, radix, nNormMin.
exists (-(Zpower_nat 2 (pred (pred (p+k)))))%Z.
apply trans_eq with (-(Zpower_nat 2 (1+(pred (pred (p+k))))))%Z; auto with zarith.
replace (1+(pred (pred (p+k)))) with (pred (p+k)); auto with zarith.
rewrite Zpower_nat_is_exp; auto with zarith.
replace (Zpower_nat 2 1) with 2%Z; auto with zarith.
unfold FtoRradix; rewrite Fminus_correct; auto with zarith; ring.
clear H7 H14; elim H16; intros T1 T2; elim T2; clear T1 T2; intros.
right; split;[elim H12; auto|split].
fold radix; fold FtoRradix; rewrite H11; auto with real.
fold radix; intros f U1 U2.
rewrite <- FSucPred with be radix (p+k) xy; auto with zarith.
2: left; auto.
rewrite <- FnormalizeCorrect with radix be (p+k) f; auto with zarith.
apply FSuccProp; auto with zarith.
apply FPredCanonic; auto with zarith; left; auto.
apply FnormalizeCanonic; auto with zarith.
rewrite FnormalizeCorrect; auto with zarith.
apply Rlt_le_trans with (2:=U2).
apply Rplus_lt_reg_r with (-FtoRradix xy)%R.
apply Rlt_le_trans with (z-y)%R;[idtac|rewrite H11; right; ring].
apply Rle_lt_trans with (-(FtoRradix ( Float 1%nat (Fexp y))))%R.
right; apply trans_eq with (-(FtoRradix (Fminus radix xy (FPred be radix (p+k) xy))))%R.
unfold FtoRradix; rewrite Fminus_correct; auto with zarith; ring.
unfold FtoRradix; rewrite FPredDiff1; auto with zarith real.
rewrite H13; auto with real.
case (Z_eq_dec (Fnum xy) ((nNormMin radix (p+k)))%Z); auto with zarith; intros K.
absurd (FNodd be radix (p+k) xy); auto.
unfold FNodd; rewrite FcanonicFnormalizeEq; auto with zarith.
2: left; auto.
unfold Fodd; apply EvenNOdd; rewrite K.
unfold Even, radix, nNormMin.
exists ((Zpower_nat 2 (pred (pred (p+k)))))%Z.
apply trans_eq with ((Zpower_nat 2 (1+(pred (pred (p+k))))))%Z; auto with zarith.
apply Rplus_lt_reg_r with (FtoRradix y).
apply Rlt_le_trans with z;[idtac|right; ring].
apply Rle_lt_trans with (FPred bo radix p y).
right; apply Rplus_eq_reg_l with (-y)%R.
apply trans_eq with (-(FtoRradix (Fminus radix y (FPred bo radix p y))))%R.
unfold FtoRradix; rewrite FPredDiff1; auto with zarith.
ring.
case (Z_eq_dec (Fnum y) ((nNormMin radix p))%Z); auto; intros K.
absurd (FNodd bo radix p y); auto.
unfold FNodd; rewrite FcanonicFnormalizeEq; auto with zarith.
unfold Fodd; apply EvenNOdd; rewrite K.
unfold Even, radix, nNormMin.
exists ((Zpower_nat 2 (pred (pred p))))%Z.
apply trans_eq with ((Zpower_nat 2 (1+(pred (pred p)))))%Z; auto with zarith.
unfold FtoRradix; rewrite Fminus_correct; auto with zarith; ring.
case (Rle_or_lt z (FPred bo radix p y)); auto; intros U3.
absurd (y <= (FPred bo radix p y))%R.
apply Rlt_not_le.
unfold FtoRradix; apply FPredLt; auto with zarith.
apply H14; auto.
apply FBoundedPred; auto with zarith.
apply FcanonicBound with radix; auto.
elim H8; intros T; clear T;unfold FNodd.
rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FcanonicFnormalizeEq; auto with zarith.
2: left; auto.
unfold Fodd; unfold Odd; intros T; elim T; intros ny U1.
exists (ny+(Fnum x*(Zpower_nat radix (Zabs_nat (Fexp x-Fexp y -1)))))%Z.
assert (Fexp (Fplus radix x y)=Fexp y)%Z.
unfold Fplus; simpl;apply Zmin_le2.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
fold FtoRradix; apply Rle_trans with (1*Rabs y)%R;[right; ring|idtac].
apply Rle_trans with (2*Rabs y)%R;[apply Rmult_le_compat_r; auto with real|idtac].
apply Rle_trans with (1:=H); rewrite Rabs_right;[idtac|apply Rle_ge]; auto with real.
apply trans_eq with (Fnum (Fplus radix x y)).
apply eq_IZR.
apply Rmult_eq_reg_l with (powerRZ radix (Fexp y)); auto with real zarith.
apply trans_eq with (FtoRradix xy);
   [rewrite <- H13; unfold FtoRradix, FtoR; auto with real|idtac].
rewrite H11; unfold FtoRradix; rewrite <- Fplus_correct; auto with zarith.
unfold FtoR; rewrite H14; auto with real.
unfold Fplus.
replace (Zmin (Fexp x) (Fexp y)) with (Fexp y).
replace (Fnum y * Zpower_nat radix (Zabs_nat (Fexp y - Fexp y)))%Z with (Fnum y); auto with zarith.
apply trans_eq with (Fnum x * Zpower_nat radix (Zabs_nat (Fexp x - Fexp y)) + Fnum y)%Z; auto with zarith.
rewrite U1; ring_simplify.
replace (Zabs_nat (Fexp x - Fexp y)) with (1+(Zabs_nat (Fexp x - Fexp y - 1))).
rewrite Zpower_nat_is_exp; auto with zarith.
replace (Zpower_nat radix 1) with 2%Z; auto with zarith; ring.
cut (1 + Zabs_nat (Fexp x - Fexp y - 1) = Zabs_nat (Fexp x - Fexp y))%Z; auto with zarith.
cut (0 <= Fexp x-Fexp y -1)%Z;[intros U2|idtac].
repeat rewrite <- Zabs_absolu; repeat rewrite Zabs_eq; auto with zarith.
apply Zplus_le_reg_r with (Fexp y+1)%Z.
ring_simplify.
case H2; intros K.
apply Zle_trans with (Fexp (Float (Fnum y) (Fexp y+1)%Z)); auto with zarith.
rewrite Zplus_comm; auto with zarith.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
elim K; intros H15 H16; elim H15; intros.
left; split;[split|simpl]; auto with zarith.
apply Zle_trans with (1:=H18); rewrite Zplus_comm; simpl; auto with zarith.
fold FtoRradix; apply Rle_trans with (2*Rabs y)%R.
unfold FtoRradix, FtoR; rewrite Zplus_comm; simpl.
rewrite powerRZ_add; auto with real zarith.
repeat rewrite Rabs_mult.
replace (Rabs (powerRZ 2 1)) with 2%R;[right; ring|idtac].
unfold powerRZ; simpl; auto with real.
ring_simplify (2*1)%R; rewrite Rabs_right; auto with real; apply Rle_ge; auto with real.
apply Rle_trans with (1:=H); rewrite Rabs_right;[idtac|apply Rle_ge]; auto with real.
apply Zle_trans with (Fexp (Float (nNormMin radix p) (-(dExp bo)+1))).
elim K; intros K1 K2; elim K2; intros K3 K4; rewrite K3.
rewrite Zplus_comm; simpl; auto with zarith.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
left; repeat split.
simpl; rewrite pGivesBound.
rewrite Zabs_eq; auto with zarith.
unfold nNormMin in |- *; simpl in |- *; auto with zarith arith.
apply Zlt_le_weak; auto with zarith.
apply nNormPos; auto with zarith.
simpl; auto with zarith.
rewrite pGivesBound.
pattern p at 1; replace p with (pred p + 1); auto with zarith.
rewrite Zabs_Zmult; rewrite Zabs_eq; auto with zarith.
rewrite Zabs_eq; auto with zarith.
rewrite Zpower_nat_is_exp; auto with zarith.
unfold nNormMin in |- *; simpl in |- *; auto with zarith arith.
fold FtoRradix; rewrite (Rabs_right x); try apply Rle_ge; auto with real.
apply Rle_trans with (2:=H1).
rewrite Rabs_right;[idtac|
  apply Rle_ge; unfold FtoRradix; apply LeFnumZERO; auto with zarith].
2: simpl; unfold nNormMin; auto with zarith.
unfold firstNormalPos, FtoRradix, FtoR; simpl.
rewrite powerRZ_add; auto with real zarith; simpl; right; ring.
ring_simplify (Fexp y-Fexp y)%Z; simpl; auto with zarith.
unfold Zpower_nat; simpl; auto with zarith.
Qed.

Theorem AddOddOdd_can: forall (x y f1 f2:float) (z:R),
    (2*(Rabs y) <= Rabs x)%R ->
    (2*(firstNormalPos radix bo p) <= Rabs x)%R ->
   Fcanonic radix bo y ->(Fcanonic radix bo x) ->
   (To_Odd bo radix p z y) ->
   (To_Odd bo radix p (x+y)%R f1) ->
   (To_Odd bo radix p (x+z)%R f2) ->
       (FtoRradix f1=f2)%R.
intros.
case (Rle_or_lt 0%R x).
intros T; case T; intros H5'.
apply AddOddOdd_aux with x y z; auto.
rewrite <- (Rabs_right x); auto with real.
rewrite <- (Rabs_right x); auto with real.
absurd (2 * firstNormalPos radix bo p <= Rabs x)%R; auto.
apply Rlt_not_le; rewrite <- H5'.
rewrite Rabs_R0.
unfold FtoRradix, FtoR, firstNormalPos, nNormMin; simpl.
repeat apply Rmult_lt_0_compat; auto with real zarith.
intros H5'.
apply Rmult_eq_reg_l with (-1)%R; auto with real; ring_simplify.
unfold FtoRradix; repeat rewrite <- Fopp_correct; fold FtoRradix.
apply AddOddOdd_aux with (Fopp x) (Fopp y) (-z)%R.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix.
rewrite Rabs_Ropp; rewrite <- (Rabs_left x); auto with real.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix; auto with real.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix; auto with real.
rewrite <- (Rabs_left x); auto with real.
apply FcanonicFopp; auto.
apply FcanonicFopp; auto.
generalize To_OddSymmetricP; unfold SymmetricP; intros T; apply T; auto.
replace (Fopp x + Fopp y)%R with (-(x+y))%R.
generalize To_OddSymmetricP; unfold SymmetricP; intros T; apply T; auto.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix; auto with real.
replace (Fopp x + -z)%R with (-(x+z))%R.
generalize To_OddSymmetricP; unfold SymmetricP; intros T; apply T; auto.
unfold FtoRradix; repeat rewrite Fopp_correct; fold FtoRradix; auto with real.
Qed.

Theorem AddOddOdd: forall (x y f1 f2:float) (z:R),
   (Fbounded bo x) ->
   (2*(Rabs y) <= Rabs x)%R ->
   (2*(firstNormalPos radix bo p) <= Rabs x)%R ->
   (To_Odd bo radix p z y) ->
   (To_Odd bo radix p (x+y)%R f1) ->
   (To_Odd bo radix p (x+z)%R f2) ->
       (FtoRradix f1=f2)%R.
intros.
apply AddOddOdd_can with (Fnormalize radix bo p x) (Fnormalize radix bo p y) z.
unfold FtoRradix; repeat rewrite FnormalizeCorrect; auto with real zarith.
unfold FtoRradix; rewrite FnormalizeCorrect; auto with real zarith.
apply FnormalizeCanonic; auto with zarith; elim H2; auto.
apply FnormalizeCanonic; auto with zarith.
apply To_OddCompatible with (4:=H2); auto with zarith.
rewrite FnormalizeCorrect; auto with real zarith.
apply FnormalizeBounded; auto with zarith; elim H2; auto.
unfold FtoRradix; repeat rewrite FnormalizeCorrect; auto with real zarith.
unfold FtoRradix; rewrite FnormalizeCorrect; auto with real zarith.
Qed.

Theorem AddOddOdd2_can: forall (x y f1 f2:float) (z:R),
    (2*(Rabs z) <= Rabs x)%R ->
    (2*(firstNormalPos radix bo p) <= Rabs x)%R ->
   Fcanonic radix bo y ->(Fcanonic radix bo x) ->
   (To_Odd bo radix p z y) ->
   (To_Odd bo radix p (x+y)%R f1) ->
   (To_Odd bo radix p (x+z)%R f2) ->
       (FtoRradix f1=f2)%R.
intros.
apply AddOddOdd_can with x y z; auto.
apply Rmult_le_reg_l with (/2)%R; auto with real.
apply Rle_trans with (Rabs y);[right; field; auto with real|idtac].
assert (FtoRradix (Fabs (Float (Fnum x) (Zpred (Fexp x)))) = / 2 * Rabs x)%R.
unfold FtoRradix; rewrite <- Fabs_correct; auto with zarith.
unfold FtoR, Fabs, Zpred, Zminus; simpl.
rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify (2*1)%R; ring.
rewrite <- H6.
unfold FtoRradix; apply RoundAbsMonotoner with bo p (To_Odd bo radix p) z; auto with zarith.
apply To_OddRoundedModeP; auto with zarith.
assert (Fbounded bo x);[apply FcanonicBound with radix; auto|idtac].
elim H7; intros.
apply absFBounded.
split; simpl; auto with zarith.
assert (Zsucc (-(dExp bo)) <= Fexp x)%Z; auto with zarith.
apply Zle_trans with (Fexp (Float (nNormMin radix p) (Zsucc (- dExp bo)))); auto with zarith.
apply Fcanonic_Rle_Zle with radix bo p; auto with zarith.
apply FcanonicNnormMin; auto with zarith.
fold FtoRradix; apply Rle_trans with (2:=H0).
rewrite Rabs_right.
unfold firstNormalPos, FtoRradix, FtoR; simpl.
unfold Zsucc; rewrite powerRZ_add; auto with real zarith; simpl; right; ring.
unfold FtoRradix; apply Rle_ge; apply LeFnumZERO; simpl; unfold nNormMin; auto with zarith.
fold FtoRradix; rewrite H6; apply Rmult_le_reg_l with 2%R; auto with real.
apply Rle_trans with (1:=H); right; field; auto with real.
Qed.

Theorem AddOddOdd2:
  forall (x y f1 f2:float) (z:R),
  Fbounded bo x ->
  (2*(Rabs z) <= Rabs x)%R ->
  (2*(firstNormalPos radix bo p) <= Rabs x)%R ->
  To_Odd bo radix p z y ->
  To_Odd bo radix p (x+y)%R f1 ->
  To_Odd bo radix p (x+z)%R f2 ->
  (FtoRradix f1 = f2)%R.
intros.
apply AddOddOdd2_can with (Fnormalize radix bo p x) (Fnormalize radix bo p y) z.
unfold FtoRradix; rewrite FnormalizeCorrect; auto with real zarith.
unfold FtoRradix; rewrite FnormalizeCorrect; auto with real zarith.
apply FnormalizeCanonic; auto with zarith; elim H2; auto.
apply FnormalizeCanonic; auto with zarith.
apply To_OddCompatible with (4:=H2); auto with zarith.
rewrite FnormalizeCorrect; auto with real zarith.
apply FnormalizeBounded; auto with zarith; elim H2; auto.
unfold FtoRradix; repeat rewrite FnormalizeCorrect; auto with real zarith.
unfold FtoRradix; rewrite FnormalizeCorrect; auto with real zarith.
Qed.

End Sec5.