Require Export discriminant2.

Section Discriminant1.
Variable bo : Fbound.
Variable precision : nat.
 
Let radix := 2%Z.

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
 
Theorem TwoMoreThanOne : (1 < radix)%Z.
unfold radix in |- *; red in |- *; simpl in |- *; auto.
Qed.
Hint Resolve TwoMoreThanOne.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ TwoMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum bo) = Zpower_nat radix precision.
Hypothesis precisionGreaterThanThree : 3 <= precision.


Theorem RoundLeNormal: forall f:float, forall r:R,
  Closest bo radix r f -> (Fnormal radix bo f) ->
  (Rabs f <= Rabs r / (1 - powerRZ radix (- precision)))%R.
intros.
assert (0 < (1 - powerRZ radix (- precision)))%R.
apply Rplus_lt_reg_r with (powerRZ radix (- precision)).
ring_simplify.
replace 1%R with (powerRZ radix 0);
    [ auto with real zarith | simpl in |- *; auto ].
apply Rmult_le_reg_l with ((1 - powerRZ radix (- precision)))%R; auto with real.
apply Rle_trans with (Rabs r);[idtac|right; field; auto with real].
apply Rplus_le_reg_l with (-Rabs r+Rabs f*powerRZ radix (-precision))%R.
apply Rle_trans with (Rabs f-Rabs r)%R;[right; ring|idtac].
apply Rle_trans with (Rabs f * powerRZ radix (- precision) )%R;[idtac|right; ring].
apply Rle_trans with (Rabs (f-r));[apply Rabs_triang_inv|idtac].
replace (f-r)%R with (-(r-f))%R;[rewrite Rabs_Ropp|ring].
apply Rmult_le_reg_l with (INR 2); auto with real.
apply Rle_trans with (Fulp bo radix precision f).
unfold FtoRradix; apply ClosestUlp; auto.
apply Rle_trans with (Rabs f*powerRZ radix (Zsucc (-precision)))%R.
unfold FtoRradix; apply FulpLe2; auto.
elim H0; auto.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
right; unfold Zsucc; rewrite powerRZ_add; auto with real zarith; simpl; ring.
Qed.


Variables a b b' c p q t d u v dp dq:float.

Let delta := (Rabs (d-(b*b'-a*c)))%R.

Hypothesis Fa : (Fbounded bo a).
Hypothesis Fb : (Fbounded bo b).
Hypothesis Fb': (Fbounded bo b').
Hypothesis Fc : (Fbounded bo c).
Hypothesis Fp : (Fbounded bo p).
Hypothesis Fq : (Fbounded bo q).
Hypothesis Fd : (Fbounded bo d).
Hypothesis Fu : (Fbounded bo u).
Hypothesis Fv : (Fbounded bo v).
Hypothesis Cand : (Fcanonic radix bo d).

(** There is no underflow *)
Hypothesis Nq:(Fnormal radix bo q).
Hypothesis Np:(Fnormal radix bo p).
Hypothesis Nv:(Fnormal radix bo v).
Hypothesis Nu:(Fnormal radix bo u).
Hypothesis U0: (- dExp bo <= Fexp p - 2)%Z.

Hypothesis Square:(0 <=b*b')%R.

Hypothesis Roundp : (EvenClosest bo radix precision (b*b')%R p).
Hypothesis Roundq : (EvenClosest bo radix precision (a*c)%R q).
Hypothesis Roundt : (EvenClosest bo radix precision (p-q)%R t).
Hypothesis dDef   : d=t.
Hypothesis Roundu : (EvenClosest bo radix precision (3*Rabs t)%R u).
Hypothesis Roundv : (EvenClosest bo radix precision (p+q)%R v).
Hypothesis dpEq   : (FtoRradix dp=b*b'-p)%R.
Hypothesis dqEq   : (FtoRradix dq=a*c-q)%R.

Hypothesis Case1 : (3*(Rabs (p-q)) < p+q )%R.
Hypothesis Case2 : (v <= u )%R.


Theorem IneqEq: (FtoRradix v=u)%R.
assert (u <= v)%R; auto with real.
generalize (EvenClosestMonotone bo radix precision); unfold MonotoneP.
intros L; apply L with (3 * Rabs (p - q))%R (p+q)%R; auto; clear L.
generalize (EvenClosestCompatible bo radix precision); unfold CompatibleP.
intros L.
apply L with (3*Rabs t)%R u; auto.
replace (FtoRradix t) with (p-q)%R; auto with real.
apply sym_eq; unfold FtoRradix, radix; apply t_exact with bo precision b b'; auto.
Qed.

Theorem dexact: (FtoRradix d=p-q)%R.
unfold FtoRradix, radix; apply t_exact with bo precision b b'; auto.
rewrite dDef; auto with real zarith.
Qed.



Theorem discri10: (q <= p)%R -> (delta <= 2*(Fulp bo radix precision d))%R.
intros G.
case (Zle_lt_or_eq (Fexp d) (Fexp q)).
apply Fcanonic_Rle_Zle with radix bo precision; auto with real zarith.
left; auto.
fold FtoRradix; rewrite Rabs_right.
rewrite Rabs_right.
rewrite dexact; apply Rplus_le_reg_l with q.
ring_simplify; apply P_le_two_Q with bo precision b b'; auto.
apply Rle_ge; left; apply Q_positive with bo precision b b' p; auto.
apply Rle_ge; rewrite dexact; apply Rplus_le_reg_l with q.
ring_simplify; auto with real.
assert ( 0 < 2+(powerRZ radix (-precision)))%R.
apply Rle_lt_trans with (0+0)%R; auto with real.
apply Rplus_lt_compat; auto with real zarith.
assert ((q <= p * (1 + powerRZ radix (1 - precision)) /
    (2 + powerRZ radix (- precision)))%R).
apply Rmult_le_reg_l with (2 + powerRZ radix (- precision))%R; auto with real.
apply Rle_trans with (p * (1 + powerRZ radix (1 - precision)))%R;[idtac|right; field; auto with real].
apply Rmult_le_reg_l with 2%R; auto with real.
apply Rplus_le_reg_l with (-2*p+p*(powerRZ radix (1-precision))-3*q*(powerRZ radix (1-precision)))%R.
apply Rle_trans with ((powerRZ radix (1-precision))*(3*(p-q)))%R;[idtac|right; ring].
apply Rle_trans with ((4*q-2*p)*(1-powerRZ radix (-precision)))%R.
right; unfold Zminus; rewrite powerRZ_add; auto with real zarith; simpl; ring.
assert (0 < (1 - powerRZ radix (- precision)))%R.
apply Rplus_lt_reg_r with (powerRZ radix (- precision)).
ring_simplify.
replace 1%R with (powerRZ radix 0);
    [ auto with real zarith | simpl in |- *; auto ].
apply Rmult_le_reg_l with (/ (1 - powerRZ radix (- precision)))%R; auto with real.
apply Rle_trans with (4 * q - 2 * p)%R;[right; field; auto with real|idtac].
apply Rle_trans with (Fulp bo radix precision v).
apply Rle_trans with (((p+q)-v) +- (3*(p-q)-v))%R;[right;ring|idtac].
apply Rle_trans with (Rabs (((p+q)-v) +- (3*(p-q)-v)));[apply RRle_abs|idtac].
apply Rle_trans with (Rabs (((p+q)-v)) +Rabs (- (3*(p-q)-v)))%R;[apply Rabs_triang|idtac].
apply Rmult_le_reg_l with 2%R; auto with real.
apply Rle_trans with  (2*(Rabs (((p+q)-v))) +2*Rabs (- (3*(p-q)-v)))%R;[right;ring|idtac].
apply Rle_trans with (Fulp bo radix precision v+Fulp bo radix precision v)%R;[idtac|right;ring].
rewrite Rabs_Ropp; replace 2%R with (INR 2); auto with real zarith.
apply Rplus_le_compat; unfold FtoRradix; apply ClosestUlp; auto with zarith.
elim Roundv; auto.
elim Roundu; intros Y1 Y2.
apply ClosestCompatible with (1:=Y1); fold FtoRradix; auto.
rewrite <- dDef; rewrite dexact.
rewrite Rabs_right; auto with real.
apply Rle_ge; apply Rplus_le_reg_l with q; auto with real.
ring_simplify (q+0)%R; apply Rle_trans with (1:=G); right; ring.
apply sym_eq; apply IneqEq.
apply Rle_trans with (Rabs v * powerRZ radix (Zsucc (- precision)))%R.
unfold FtoRradix; apply FulpLe2; auto.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
unfold Zsucc; replace (-precision+1)%Z with (1-precision)%Z; auto with zarith.
apply Rle_trans with  (((3 * (p - q))*/(1 - powerRZ radix (- precision)))* powerRZ radix (1 - precision))%R;
   [idtac|right; ring].
apply Rmult_le_compat_r; auto with real zarith.
assert (0 <= p-q)%R.
apply Rplus_le_reg_l with q; auto with real.
ring_simplify (q+0)%R; apply Rle_trans with (1:=G); right; ring.
apply Rle_trans with  (Rabs (3 * Rabs t) / (1 - powerRZ radix (- precision)))%R.
rewrite IneqEq.
apply RoundLeNormal; auto.
elim Roundu; auto.
rewrite <- dDef; rewrite dexact.
rewrite Rabs_right;[rewrite Rabs_right; auto with real; right; ring|idtac].
rewrite Rabs_right; auto with real.
apply Rle_ge; apply Rle_trans with (3*0)%R; auto with real.
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with 2%R; auto with real.
intros W.
case (Zle_lt_or_eq (Fexp q) (Fexp p)).
apply Fcanonic_Rle_Zle with radix bo precision; auto with zarith.
left; auto.
left; auto.
assert (0 <= q)%R.
left; apply Q_positive with bo precision b b' p; auto.
fold FtoRradix; repeat rewrite Rabs_right; auto with real.
apply Rle_ge; apply Rle_trans with (1:=H1); auto with real.
intros M.
assert (exists qq:float, (FtoRradix qq=2*q)%R /\ Fbounded bo qq /\ Fnormal radix bo qq
  /\ Fnum qq=Fnum q /\ (Fexp qq=Fexp q+1)%Z).
exists (Float (Fnum q) ((Fexp q)+1)).
elim Nq; intros F1 F2; elim F1; intros.
split;[unfold FtoRradix, FtoR; simpl|idtac].
rewrite powerRZ_add; auto with real zarith; simpl; ring.
repeat split; simpl; auto with zarith.
elim H1; intros qq H1'; elim H1'; intros J1 H2; elim H2; intros J2 H3; elim H3; 
  intros J3 H4; elim H4; intros J4 J5;clear H1' H1 H2 H3 H4.
assert (2*q=FSucc bo radix precision p)%R.
rewrite <- J1.
assert ((FSucc bo radix precision p <= qq)%R /\ (qq <= FSucc bo radix precision p)%R).
2: elim H1; auto with real.
split.
unfold FtoRradix; apply FSuccProp; auto with real zarith.
left; auto.
left; auto.
fold FtoRradix; rewrite J1.
assert (p <= 2*q)%R.
apply P_le_two_Q with bo precision b b'; auto.
case H1; auto.
intros A.
absurd (3 * Rabs (p - q) < p + q)%R; auto.
apply Rle_not_lt; rewrite A.
ring_simplify (2*q-q)%R; rewrite Rabs_right.
right; ring.
apply Rle_ge; left; apply Q_positive with bo precision b b' p; auto.
case (Rle_or_lt  qq (FSucc bo radix precision p)); auto; intros N.
absurd (FSucc bo radix precision (FSucc bo radix precision p) <= qq)%R.
2: unfold FtoRradix; apply FSuccProp; auto with zarith.
2: apply FSuccCanonic; auto with zarith.
2: left; auto.
2: left; auto.
apply Rlt_not_le.
apply Rle_lt_trans with (2*(p*(1+powerRZ radix (1-precision))/(2+(powerRZ radix (-precision)))))%R.
rewrite J1; apply Rmult_le_compat_l; auto with real.
assert (0 < (powerRZ radix precision) - 1)%R.
apply Rplus_lt_reg_r with 1%R; ring_simplify.
replace 1%R with (powerRZ radix 0); auto with real zarith.
apply Rlt_le_trans with (p*(((powerRZ radix precision)+1)/((powerRZ radix precision) -1)))%R.
apply Rle_lt_trans with (p*((2 + 2*powerRZ radix (1 - precision)) / (2 + powerRZ radix (- precision))))%R;
  [right; unfold Rdiv; ring|idtac].
apply Rmult_lt_compat_l.
apply Rlt_le_trans with (2:=G).
apply Q_positive with bo precision b b' p; auto.
apply Rmult_lt_reg_l with (powerRZ radix precision - 1)%R; auto with real.
apply Rlt_le_trans with (powerRZ radix precision + 1)%R;[idtac|right; field; auto with real].
apply Rmult_lt_reg_l with (2+powerRZ radix (-precision))%R; auto with real.
apply Rle_lt_trans with ((powerRZ radix precision - 1) *
     ((2 + 2 * powerRZ radix (1 - precision))))%R;[right; field; auto with real|idtac].
apply Rle_lt_trans with (2*powerRZ radix precision+2+-2*powerRZ radix (1-precision))%R;
  [right; ring_simplify|idtac].
rewrite Rmult_assoc.
repeat rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (precision+(1-precision))%Z; simpl; ring.
apply Rlt_le_trans with (2 * powerRZ radix precision + 2 +1+powerRZ radix (-precision))%R.
repeat rewrite Rplus_assoc; repeat apply Rplus_lt_compat_l.
apply Rle_lt_trans with (1+0)%R; auto with real.
ring_simplify (1+0)%R; apply Rle_trans with 0%R; auto with real.
apply Ropp_le_cancel; ring_simplify ( - (-2 * powerRZ radix (1 - precision)))%R.
apply Rle_trans with (2*0)%R; auto with real zarith.
right; ring.
right; ring_simplify.
rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (precision+-precision)%Z; simpl; ring.
apply Rle_trans with (p+2*Fulp bo radix precision p)%R.
apply Rmult_le_reg_l with  (powerRZ radix precision - 1)%R; auto with real.
apply Rle_trans with  (p * ((powerRZ radix precision + 1)))%R;[right; field; auto with real|idtac].
apply Rle_trans with ((powerRZ radix precision -1)*p+2*p)%R;[right; ring|idtac].
apply Rle_trans with ((powerRZ radix precision -1)*p
  + 2*((powerRZ radix precision - 1)* Fulp bo radix precision p))%R;[idtac|right; ring].
apply Rplus_le_compat_l.
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with (Rabs p);[apply RRle_abs|idtac].
unfold FtoRradix; apply FulpGe; auto.
apply Rplus_le_reg_l with (-(FSucc bo radix precision p))%R.
apply Rle_trans with (Fminus radix (FSucc bo radix precision (FSucc bo radix precision p)) 
  (FSucc bo radix precision p));[idtac|unfold FtoRradix; rewrite Fminus_correct; auto; right; ring].
unfold FtoRradix; rewrite FSuccDiff1; auto with zarith.
rewrite <- CanonicFulp with bo radix precision (FSucc bo radix precision p); auto with zarith.
2:apply FSuccCanonic; auto with zarith; left; auto.
apply Rle_trans with (-(Fminus radix (FSucc  bo radix precision p) p)+ 2 * Fulp bo radix precision p)%R;
  [unfold FtoRradix; rewrite Fminus_correct; auto; right; ring|idtac].
unfold FtoRradix; rewrite FSuccDiff1; auto with zarith.
rewrite <- CanonicFulp with bo radix precision p; auto with zarith.
2: left; auto.
ring_simplify.
apply LeFulpPos; auto with zarith.
apply FBoundedSuc; auto with zarith.
fold FtoRradix; apply P_positive with bo precision b b'; auto.
left; apply FSuccLt; auto with zarith.
assert (0 <  nNormMin radix precision)%Z;[apply nNormPos; auto with zarith|idtac].
assert (0 <= Fnum p)%Z; auto with zarith.
apply LeR0Fnum with radix; auto with real zarith.
apply P_positive with bo precision b b'; auto.
assert (0 <  nNormMin radix precision)%Z;[apply nNormPos; auto with zarith|idtac].
assert (0 <= Fnum (FSucc bo radix precision p))%Z; auto with zarith.
apply LeR0Fnum with radix; auto with real zarith.
apply Rle_trans with (FtoR radix p).
apply P_positive with bo precision b b'; auto.
left; apply FSuccLt; auto with zarith.
assert (Fexp d = Fexp q-1)%Z.
assert (Fexp q -1 <= Fexp d)%Z; auto with zarith.
apply Zle_trans with (Fexp p-2)%Z; auto with zarith.
apply Zle_trans with (Fexp (Float (Fnum p) (Fexp p-2))); auto with zarith.
apply Fcanonic_Rle_Zle with radix bo precision; auto with real zarith.
elim Np; intros Y1 Y2; elim Y1; intros; left; split;try split; simpl; auto with zarith.
apply Rle_trans with (p/4)%R.
unfold Rdiv, FtoRradix, FtoR; simpl.
rewrite Rabs_mult; repeat rewrite Rabs_right.
unfold Zminus; rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify (2*1)%R; right; ring.
apply Rle_ge; auto with real zarith.
apply Rle_ge; assert (0 <= Fnum p)%Z; auto with real zarith.
apply LeR0Fnum with radix; auto with real zarith.
fold FtoRradix; apply P_positive with bo precision b b'; auto.
fold FtoRradix; rewrite dexact.
rewrite Rabs_right.
2: apply Rle_ge; apply Rplus_le_reg_l with q.
2: ring_simplify; auto with real.
apply Rle_trans with (p- p * (1 + powerRZ radix (1 - precision)) /
        (2 + powerRZ radix (- precision)))%R; auto with real.
2: unfold Rminus; apply Rplus_le_compat_l; auto with real.
unfold Rdiv; apply Rle_trans with (p*(1-(1 + powerRZ radix (1 - precision)) */
    (2 + powerRZ radix (- precision))))%R;[idtac|right; ring].
apply Rmult_le_compat_l.
apply P_positive with bo precision b b'; auto.
apply Rmult_le_reg_l with 4%R; auto with real.
apply Rlt_le_trans with 2%R; auto with real.
apply Rmult_le_reg_l with (2 + powerRZ radix (- precision))%R; auto with real.
apply Rle_trans with (2 + powerRZ radix (- precision))%R;
  [right; field|idtac].
assert (0 < 4)%R; [apply Rlt_le_trans with 2%R|idtac]; auto with real.
apply Rle_trans with (4* (2 + powerRZ radix (- precision))-
  4*(1 + powerRZ radix (1 - precision)))%R;[idtac|right;field; auto with real].
unfold Zminus; rewrite powerRZ_add; auto with real zarith.
apply Rplus_le_reg_l with (-2+4*powerRZ radix (-precision))%R.
apply Rle_trans with (5*powerRZ radix (-precision))%R;[right; ring|idtac].
apply Rle_trans with 2;[idtac|simpl; right; ring].
apply Rle_trans with (powerRZ radix 0); auto with real zarith.
apply Rle_trans with (powerRZ radix (3-precision)); auto with real zarith.
unfold Zminus; rewrite powerRZ_add; auto with real zarith.
apply Rmult_le_compat_r; auto with real zarith.
simpl; apply Rle_trans with (5+1+1+1)%R; [idtac|right; ring].
apply Rle_trans with (5+0+0+0)%R; [right; ring|idtac].
repeat apply Rplus_le_compat; auto with real.
apply Rle_powerRZ; auto with real zarith.
case (Zle_lt_or_eq (nNormMin radix precision) (Fnum q)).
elim Nq; intros.
apply Zmult_le_reg_r with radix; auto with zarith.
rewrite Zmult_comm; rewrite <- PosNormMin with radix bo precision; auto with zarith.
apply Zle_trans with (1:=H4); rewrite Zabs_eq; auto with zarith.
assert (0 < Fnum q)%Z; auto with zarith.
apply LtR0Fnum with radix; auto with real zarith.
apply Q_positive with bo precision b b' p; auto.
intros P.
assert (Fnum q < nNormMin radix precision+2)%Z.
apply lt_IZR; rewrite plus_IZR; simpl.
apply Rmult_lt_reg_l with (powerRZ radix (Fexp q)); auto with real zarith.
apply Rle_lt_trans with q;[unfold FtoRradix, FtoR; auto with real|idtac].
apply Rplus_lt_reg_r with (-2*powerRZ radix (Fexp q))%R.
apply Rlt_le_trans with (powerRZ radix (Fexp q) * (nNormMin radix precision))%R;
  [idtac|right; ring].
apply Rle_lt_trans with d;[rewrite dexact|idtac].
apply Rplus_le_reg_l with q.
ring_simplify (q + (p - q))%R;right.
rewrite <- FPredSuc with bo radix precision p; auto with zarith.
2: left; auto.
replace (FSucc bo radix precision p) with qq.
rewrite FPredSimpl4; auto with zarith.
unfold FtoRradix, FtoR, Zpred; simpl; rewrite J4; rewrite J5; ring_simplify.
rewrite plus_IZR; rewrite powerRZ_add; auto with real zarith; simpl; ring.
assert (- pPred (vNum bo) < Fnum qq)%Z; auto with zarith.
apply Zlt_trans with (nNormMin radix precision); auto with zarith.
assert (0 < pPred (vNum bo))%Z.
apply pPredMoreThanOne with radix precision; auto with zarith.
apply Zlt_trans with 0%Z; auto with zarith.
apply nNormPos; auto with zarith.
apply FcanonicUnique with radix bo precision; auto with zarith real.
left; auto.
apply FSuccCanonic; auto with zarith.
left; auto.
fold FtoRradix; rewrite J1; auto with real.
apply Rle_lt_trans with (Rabs d);[apply RRle_abs|idtac].
unfold FtoRradix; rewrite <- Fabs_correct; auto.
unfold Fabs, FtoR; simpl.
apply Rlt_le_trans with  (powerRZ 2 precision*  powerRZ 2 (Fexp d))%R.
apply Rmult_lt_compat_r; auto with real zarith.
assert (Fbounded bo d);[rewrite dDef; elim Roundt; intros I1 I2; elim I1; auto|idtac].
elim H3; intros.
apply Rlt_le_trans with (Zpos (vNum bo)); auto with real zarith.
right; rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real.
unfold nNormMin; repeat rewrite <- powerRZ_add; auto with real zarith.
rewrite Zpower_nat_Z_powerRZ; repeat rewrite <- powerRZ_add; auto with real zarith.
replace (Fexp q+pred precision)%Z with (precision+Fexp d)%Z; auto with real zarith.
rewrite inj_pred; auto with zarith; unfold Zpred; rewrite H2; ring.
assert (Fnum q= nNormMin radix precision + 1)%Z; auto with zarith.
clear P H3.
assert (p=Float (nNormMin radix precision) (Fexp q+1)).
rewrite <- FPredSuc with bo radix precision p; auto with zarith.
2: left; auto.
replace (FSucc bo radix precision p) with qq.
rewrite FPredSimpl4; auto with zarith.
rewrite J4; rewrite J5; rewrite H4; unfold Zpred; auto with zarith.
ring_simplify  (nNormMin radix precision + 1 + -1)%Z; auto.
assert (- pPred (vNum bo) < Fnum qq)%Z; auto with zarith.
rewrite J4; rewrite H4.
apply Zlt_trans with (nNormMin radix precision); auto with zarith.
assert (0 < pPred (vNum bo))%Z.
apply pPredMoreThanOne with radix precision; auto with zarith.
apply Zlt_trans with 0%Z; auto with zarith.
apply nNormPos; auto with zarith.
apply FcanonicUnique with radix bo precision; auto with zarith real.
left; auto.
apply FSuccCanonic; auto with zarith.
left; auto.
fold FtoRradix; rewrite J1; auto with real.
Contradict Case2; apply Rlt_not_le.
assert (FtoRradix p=powerRZ radix (Fexp q)*powerRZ radix precision)%R.
rewrite H3; unfold FtoRradix, FtoR; simpl.
unfold nNormMin; rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred; auto with zarith.
repeat rewrite <- powerRZ_add; auto with real zarith.
replace (Fexp q+precision)%Z with (Zpred precision+(Fexp q+1))%Z;unfold Zpred; auto with real zarith.
assert (FtoRradix q=powerRZ radix (Fexp q)*(powerRZ radix (precision-1)+1))%R.
unfold FtoRradix, FtoR; rewrite H4; rewrite plus_IZR; simpl.
unfold nNormMin; rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred; auto with zarith.
unfold Zpred, Zminus; simpl; ring.
assert (exists w1:float, Fbounded bo w1 /\ (FtoRradix w1=powerRZ radix (Fexp q)*
  (powerRZ radix precision+powerRZ radix (precision-1)-2))%R).
exists (Float (Zpower_nat radix (pred precision)+Zpower_nat radix (pred (pred precision))-1)
    (Fexp q+1)).
split;[split; simpl|idtac].
rewrite Zabs_eq; auto with zarith.
rewrite pGivesBound; apply Zlt_le_trans with  
 (Zpower_nat radix (pred precision) + Zpower_nat radix (pred precision))%Z.
unfold Zminus; rewrite <- Zplus_assoc; apply Zplus_lt_compat_l.
apply Zlt_le_trans with  
 (Zpower_nat radix (pred (pred precision)) + Zpower_nat radix (pred (pred precision)))%Z.
apply Zplus_lt_compat_l; auto with zarith.
apply Zlt_trans with 0%Z; auto with zarith.
pattern (pred precision) at 3; replace (pred precision) with (1+pred (pred precision)); auto with zarith.
rewrite Zpower_nat_is_exp.
replace (Zpower_nat radix 1) with 2%Z; auto with zarith.
pattern precision at 3; replace precision with (1+pred precision); auto with zarith.
rewrite Zpower_nat_is_exp.
replace (Zpower_nat radix 1) with 2%Z; auto with zarith.
assert (1 <=  Zpower_nat radix (pred precision) +
    Zpower_nat radix (pred (pred precision)))%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (pred precision)+0)%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (pred precision))%Z; auto with zarith.
elim J2; rewrite <- J5; auto.
unfold FtoRradix, FtoR; simpl.
unfold Zminus; repeat rewrite plus_IZR; simpl.
repeat rewrite Zpower_nat_Z_powerRZ.
repeat rewrite inj_pred; auto with zarith; unfold Zpred.
repeat rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify (2*1)%R; field; auto with real.
assert (0 < 4)%R;[apply Rlt_le_trans with 2%R|idtac]; auto with real.
intros.
elim H7; intros w1 T1; elim T1; intros W11 W12; clear H7 T1.
apply Rle_lt_trans with w1.
apply Rle_trans with (Rabs u);[apply RRle_abs|idtac];unfold FtoRradix.
apply RoundAbsMonotoner with bo precision (EvenClosest bo radix precision) (3*Rabs t)%R; 
   auto with zarith.
apply EvenClosestRoundedModeP; auto.
fold FtoRradix; rewrite <- dDef; rewrite dexact.
rewrite Rabs_right.
rewrite Rabs_right.
rewrite H5; rewrite H6.
apply Rle_trans with (w1-powerRZ radix (Fexp q))%R.
rewrite W12; right; ring_simplify.
unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify (2*1)%R; field; auto with real.
apply Rle_trans with (w1-0)%R; auto with real.
unfold Rminus; apply Rplus_le_compat_l; auto with real zarith.
apply Rle_ge; apply Rplus_le_reg_l with q.
ring_simplify; auto with real.
apply Rle_ge; apply Rle_trans with (3*0)%R; auto with real.
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with 2%R; auto with real.
assert (exists w2:float, Fbounded bo w2 /\ (FtoRradix w2=powerRZ radix (Fexp q)*
  (powerRZ radix precision+powerRZ radix (precision-1)))%R).
exists (Float (Zpower_nat radix (pred precision)+Zpower_nat radix (pred (pred precision)))
    (Fexp q+1)).
split;[split; simpl|idtac].
rewrite Zabs_eq; auto with zarith.
rewrite pGivesBound; apply Zlt_le_trans with  
 (Zpower_nat radix (pred precision) + Zpower_nat radix (pred precision))%Z.
apply Zplus_lt_compat_l; auto with zarith.
pattern precision at 3; replace precision with (1+pred precision); auto with zarith.
rewrite Zpower_nat_is_exp.
replace (Zpower_nat radix 1) with 2%Z; auto with zarith.
elim J2; rewrite <- J5; auto.
unfold FtoRradix, FtoR; simpl.
unfold Zminus; repeat rewrite plus_IZR; simpl.
repeat rewrite Zpower_nat_Z_powerRZ.
repeat rewrite inj_pred; auto with zarith; unfold Zpred.
repeat rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify (2*1)%R; field; auto with real.
assert (0 < 4)%R;[apply Rlt_le_trans with 2%R|idtac]; auto with real.
elim H7; intros w2 T1; elim T1; intros W21 W22; clear H7 T1.
apply Rlt_le_trans with w2.
rewrite W12; rewrite W22; apply Rmult_lt_compat_l; auto with real zarith.
unfold Rminus; rewrite Rplus_assoc.
apply Rplus_lt_compat_l; auto with real zarith.
apply Rlt_le_trans with  (powerRZ radix (precision - 1) + -0)%R; auto with real.
right; ring.
assert (0 <= p+q)%R.
apply Rle_trans with (0+0)%R;auto with real; apply Rplus_le_compat.
apply P_positive with bo precision b b'; auto.
left; apply Q_positive with bo precision b b' p; auto.
apply Rle_trans with (Rabs v).
unfold FtoRradix; apply RoundAbsMonotonel with bo precision 
  (EvenClosest bo radix precision) (p+q)%R;auto with zarith.
apply EvenClosestRoundedModeP; auto.
fold FtoRradix; rewrite Rabs_right; auto with real.
apply Rle_trans with (w2+0)%R; auto with real zarith.
apply Rle_trans with (w2+powerRZ radix (Fexp q))%R; auto with real zarith.
rewrite W22; rewrite H5; rewrite H6; right;ring.
rewrite Rabs_right; auto with real; apply Rle_ge.
unfold FtoRradix; apply RleRoundedR0 with bo precision 
   (EvenClosest bo radix precision) (p+q)%R; auto.
apply EvenClosestRoundedModeP; auto.
intros P.
assert (p=Float (pPred (vNum bo)) (Fexp q)).
rewrite <- FPredSuc with bo radix precision p; auto with zarith.
2: left; auto.
replace (FSucc bo radix precision p) with qq.
rewrite FPredSimpl2; auto with zarith.
replace (Zpred (Fexp qq)) with (Fexp q); auto.
rewrite J5; unfold Zpred; auto with zarith.
rewrite J5; assert (-dExp bo <= Fexp q)%Z; auto with zarith float.
apply FcanonicUnique with radix bo precision; auto with zarith real.
left; auto.
apply FSuccCanonic; auto with zarith.
left; auto.
fold FtoRradix; rewrite J1; auto with real.
Contradict M.
rewrite H3; simpl; auto with zarith.
intros M.
apply Rle_trans with (Rabs (-(dp-dq)))%R.
unfold delta; replace (d - (b * b' - a * c))%R with (-(dp-dq))%R; auto with real.
rewrite dexact; rewrite dpEq; rewrite dqEq; ring.
rewrite Rabs_Ropp. 
unfold Rminus; apply Rle_trans with (Rabs dp + Rabs (-dq))%R;[apply Rabs_triang|rewrite Rabs_Ropp].
apply Rmult_le_reg_l with 2%R; auto with real.
apply Rle_trans with (INR 2*Rabs dp + INR 2*Rabs dq)%R;[right; simpl; ring|idtac].
apply Rle_trans with (Fulp bo radix precision p+Fulp bo radix precision q)%R;
  [apply Rplus_le_compat|idtac].
rewrite dpEq; unfold FtoRradix; apply ClosestUlp; auto with zarith.
elim Roundp; auto.
rewrite dqEq; unfold FtoRradix; apply ClosestUlp; auto with zarith.
elim Roundq; auto.
repeat rewrite CanonicFulp; auto with zarith.
2: left; auto.
2: left; auto.
rewrite M; unfold FtoR;simpl.
apply Rle_trans with (2* powerRZ 2 (Fexp p))%R;[right; ring|idtac].
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with (powerRZ 2 (Fexp d+1));[idtac|
   rewrite powerRZ_add; auto with real zarith; simpl; right; ring].
apply Rle_powerRZ; auto with real.
assert (Fexp p-1 <= Fexp d)%Z; auto with zarith.
assert (exists f:float, (Fexp f=Fexp p-1)%Z /\ 
  (FtoRradix f=powerRZ radix (precision-2+Fexp p))%R
     /\ Fnormal radix bo f).
exists (Float (nNormMin radix precision) (Fexp p -1)).
split;simpl; auto with zarith.
split;[unfold FtoRradix, FtoR, nNormMin; simpl|idtac].
rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred; auto with zarith.
rewrite <- powerRZ_add; auto with real zarith.
replace (Zpred precision + (Fexp p - 1))%Z with (precision - 2 + Fexp p)%Z;
  [auto with real|unfold Zpred; ring].
split;[split;simpl; auto with zarith|idtac].
rewrite Zabs_eq; auto with zarith float.
apply ZltNormMinVnum; auto with zarith.
assert  (0 < nNormMin radix precision)%Z; auto with zarith.
apply nNormPos; auto with zarith.
simpl (Fnum (Float (nNormMin radix precision) (Fexp p - 1))).
rewrite <- PosNormMin with radix bo precision; auto with zarith.
elim H1; intros f H1'; elim H1'; intros K1 H2; elim H2; intros K2 K3;clear H1' H1 H2.
rewrite <- K1.
apply Fcanonic_Rle_Zle with radix bo precision; auto with zarith.
left; auto.
fold FtoRradix; rewrite dexact; rewrite K2.
rewrite Rabs_right;[idtac|apply Rle_ge; auto with real zarith].
rewrite Rabs_right.
2:apply Rle_ge;apply Rplus_le_reg_l with q.
2: ring_simplify; auto with real.
apply Rmult_le_reg_l with 3%R; auto with real.
apply Rlt_le_trans with 2%R; auto with real.
apply Rle_trans with ((2*powerRZ radix (precision-1+Fexp p))*(1-powerRZ radix (-precision)))%R.
replace (powerRZ radix (precision - 1 + Fexp p)) with
   (2*powerRZ radix (precision - 2 + Fexp p))%R;
  [idtac|unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith; simpl].
2: ring_simplify (2*1)%R; field; auto with real.
2: assert (0 < 4*2)%R; auto with real.
2: assert (0 < 4)%R; auto with real.
2: apply Rlt_le_trans with 2%R; auto with real.
2: apply Rle_lt_trans with (0*2)%R; auto with real.
apply Rle_trans with ((2*2* (1 - powerRZ radix (- precision)))* 
  powerRZ radix (precision - 2 + Fexp p))%R;[idtac|right; ring].
apply Rmult_le_compat_r; auto with real zarith.
apply Rplus_le_reg_l with (-3+4*powerRZ radix (- precision))%R.
ring_simplify.
apply Rle_trans with (powerRZ radix (2+-precision));
  [rewrite powerRZ_add; auto with real zarith; simpl; right; ring|idtac].
apply Rle_trans with (powerRZ radix 0); auto with real zarith.
assert (0 < (1 - powerRZ radix (- precision)))%R.
apply Rplus_lt_reg_r with (powerRZ radix (- precision)).
ring_simplify.
replace 1%R with (powerRZ radix 0);
    [ auto with real zarith | simpl in |- *; auto ].
apply Rle_trans with (v* (1 - powerRZ radix (- precision)))%R.
apply Rmult_le_compat_r; auto with real.
assert (exists g:float, Fbounded bo g /\ 
  (FtoRradix g= 2 * powerRZ radix (precision - 1 + Fexp p))%R).
exists (Float 1%Z (Fexp p +precision))%Z.
split;[split; simpl; auto with zarith float|idtac].
apply vNumbMoreThanOne with radix precision; auto with zarith.
unfold FtoRradix, FtoR; simpl;unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith.
simpl; ring_simplify (2*1)%R; field; auto with real.
clear K1 K2 K3 f; elim H3; intros g H1'; elim H1'; intros K1 K2; clear H3 H1'.
rewrite <- K2; unfold FtoRradix.
apply EvenClosestMonotone2 with bo precision g (p+q)%R; auto with real zarith.
rewrite K2; apply Rle_trans with ( powerRZ radix (precision - 1 + Fexp p)+
 powerRZ radix (precision - 1 + Fexp p))%R;[right; ring|idtac].
assert (forall f:float, Fnormal radix bo f ->  (0 <= f)%R ->
  (powerRZ radix (precision - 1 + Fexp f) <= f)%R).
intros f Hf Hf'; rewrite powerRZ_add; auto with real zarith.
unfold FtoRradix, FtoR; apply Rmult_le_compat_r; auto with real zarith.
elim Hf; intros.
apply Rmult_le_reg_l with (radix); auto with real zarith.
apply Rle_trans with  (Zpos (vNum bo)).
rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ.
unfold Zminus; rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify (2*1)%R; right; field; auto with real.
apply Rle_trans with  (Zabs (radix * Fnum f)); auto with real zarith.
rewrite Zabs_Zmult; repeat rewrite Zabs_eq; auto with real zarith.
rewrite mult_IZR; auto with real zarith.
apply LeR0Fnum with radix; auto with real zarith.
apply Rplus_le_compat;[apply H3; auto|idtac].
apply P_positive with bo precision b b'; auto.
rewrite <- M; apply H3; auto.
left; apply Q_positive with bo precision b b' p; auto.
unfold FtoRradix; apply RoundedModeProjectorIdem with bo; auto.
apply EvenClosestRoundedModeP; auto with zarith.
apply Rmult_le_reg_l with (/(1 - powerRZ radix (- precision)))%R; auto with real.
apply Rle_trans with (FtoRradix v);[right; field; auto with real|idtac].
replace  (3 * (p - q))%R with (Rabs (3*Rabs t)).
apply Rle_trans with (Rabs (3*Rabs t) /  (1 - powerRZ radix (- precision)))%R;
  [idtac|right; unfold Rdiv; ring].
apply Rle_trans with (Rabs v);[apply RRle_abs|idtac]. 
rewrite IneqEq.
apply RoundLeNormal; auto.
elim Roundu; auto.
rewrite <- dDef; rewrite dexact; auto.
rewrite Rabs_right;[idtac|apply Rle_ge].
rewrite Rabs_right;[idtac|apply Rle_ge]; auto with real.
apply Rplus_le_reg_l with q.
ring_simplify; auto with real.
apply Rle_trans with (0*0)%R; auto with real; apply Rmult_le_compat; auto with real.
apply Rle_trans with 2%R; auto with real.
intros M.
apply Rle_trans with (Rabs (-(dp-dq)))%R.
unfold delta; replace (d - (b * b' - a * c))%R with (-(dp-dq))%R; auto with real.
rewrite dexact; rewrite dpEq; rewrite dqEq; ring.
rewrite Rabs_Ropp. 
apply Rle_trans with (3 / 2 * Rmin (Fulp bo 2 precision p) (Fulp bo 2 precision q))%R.
apply dp_dq_le with a b b' c; auto.
replace  (Rmin (Fulp bo 2 precision p) (Fulp bo 2 precision q))
  with (Fulp bo 2 precision q).
apply Rmult_le_compat; auto with real zarith.
unfold Rdiv; apply Rle_trans with (0*0)%R; auto with real.
apply Rmult_le_compat; auto with real zarith.
apply Rle_trans with 2%R; auto with real.
unfold Fulp; auto with real zarith.
apply Rmult_le_reg_l with 2%R; auto with real.
apply Rle_trans with 3%R;[right; field|idtac]; auto with real.
apply Rle_trans with (3+1)%R; auto with real; right; ring.
repeat rewrite CanonicFulp; auto with zarith.
right; rewrite M; auto with real.
left; auto.
repeat rewrite CanonicFulp; auto with zarith.
2: left; auto.
2: left; auto.
rewrite Rmin_comm.
unfold Rmin.
case  (Rle_dec (FtoR 2 (Float (S 0) (Fexp q)))
         (FtoR 2 (Float (S 0) (Fexp p)))); auto with real.
intros N.
absurd (Fexp q <= Fexp p)%Z.
assert (Fexp p < Fexp q)%Z; auto with zarith.
apply Zlt_powerRZ with radix; auto with real zarith.
apply Rle_lt_trans with (FtoR 2 (Float (S 0) (Fexp p)));
  [right; unfold FtoR; simpl; ring|idtac].
apply Rlt_le_trans with (FtoR 2 (Float (S 0) (Fexp q))); auto with real.
right; unfold FtoR; simpl; ring.
apply Fcanonic_Rle_Zle with radix bo precision; auto with real zarith.
left; auto.
left; auto.
fold FtoRradix; rewrite Rabs_right.
rewrite Rabs_right; auto with real.
apply Rle_ge; apply P_positive with bo precision b b'; auto.
apply Rle_ge; left; apply Q_positive with bo precision b b' p; auto.
Qed.
End Discriminant1.


Section Discriminant2.
Variable bo : Fbound.
Variable precision : nat.
 
Let radix := 2%Z.

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
 
Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ TwoMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum bo) = Zpower_nat radix precision.
Hypothesis precisionGreaterThanThree : 3 <= precision.

Variables a b b' c p q t d u v dp dq:float.

Let delta := (Rabs (d-(b*b'-a*c)))%R.

Hypothesis Fa : (Fbounded bo a).
Hypothesis Fb : (Fbounded bo b).
Hypothesis Fb': (Fbounded bo b').
Hypothesis Fc : (Fbounded bo c).
Hypothesis Fp : (Fbounded bo p).
Hypothesis Fq : (Fbounded bo q).
Hypothesis Fd : (Fbounded bo d).
Hypothesis Fu : (Fbounded bo u).
Hypothesis Fv : (Fbounded bo v).
Hypothesis Cand : (Fcanonic radix bo d).

(** There is no underflow *)
Hypothesis Nq:(Fnormal radix bo q).
Hypothesis Np:(Fnormal radix bo p).
Hypothesis Nv:(Fnormal radix bo v).
Hypothesis Nu:(Fnormal radix bo u).
Hypothesis U0: (- dExp bo <= Fexp p - 2)%Z.
Hypothesis U1: (- dExp bo <= Fexp q - 2)%Z.

Hypothesis Square:(0 <=b*b')%R.

Hypothesis Roundp : (EvenClosest bo radix precision (b*b')%R p).
Hypothesis Roundq : (EvenClosest bo radix precision (a*c)%R q).
Hypothesis Roundt : (EvenClosest bo radix precision (p-q)%R t).
Hypothesis dDef   : d=t.
Hypothesis Roundu : (EvenClosest bo radix precision (3*Rabs t)%R u).
Hypothesis Roundv : (EvenClosest bo radix precision (p+q)%R v).
Hypothesis dpEq   : (FtoRradix dp=b*b'-p)%R.
Hypothesis dqEq   : (FtoRradix dq=a*c-q)%R.

Hypothesis Case1 : (3*(Rabs (p-q)) < p+q )%R.
Hypothesis Case2 : (v <= u )%R.


Theorem discri11: (delta <= 2*(Fulp bo radix precision d))%R.
case (Rle_or_lt q p); intros.
unfold delta, FtoRradix; apply discri10 with p q t u v dp dq; auto.
case (Rle_or_lt 0%R (a*c)%R)%R; intros.
unfold delta.
replace (d - (b * b' - a * c))%R with (-(Fopp d-(a*c-b*b')))%R;unfold FtoRradix;
  [idtac|rewrite Fopp_correct; ring].
rewrite Rabs_Ropp; apply Rle_trans with  (2 * Fulp bo radix precision (Fopp d))%R.
generalize (EvenClosestSymmetric bo radix precision); unfold SymmetricP; intros L.
apply discri10 with q p (Fopp t) u v dq dp; auto with real.
apply FcanonicFopp; auto with zarith.
fold radix; fold FtoRradix; replace (q-p)%R with (-(p-q))%R;[apply L; auto|ring].
rewrite dDef; auto.
rewrite Fopp_correct; rewrite Rabs_Ropp; auto.
rewrite Rplus_comm; auto.
fold radix; fold FtoRradix; rewrite Rplus_comm with q p; apply Rle_lt_trans with (2:=Case1).
replace (q-p)%R with (-(p-q))%R;[rewrite Rabs_Ropp|ring]; auto with real.
unfold Fulp; rewrite Fnormalize_Fopp; unfold Fopp; simpl; auto with real zarith.
absurd (0<q)%R.
apply Rle_not_lt; unfold FtoRradix.
apply RleRoundedLessR0 with bo precision (EvenClosest bo radix precision) (a*c)%R; 
  auto with real zarith float.
apply Q_positive with bo precision b b' p; auto.
Qed.

End Discriminant2.


Section Discriminant3.
Variable bo : Fbound.
Variable precision : nat.
 
Let radix := 2%Z.

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

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ TwoMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum bo) = Zpower_nat radix precision.
Hypothesis precisionGreaterThanFour : 4 <= precision.

Variables a b b' c p q t dp dq s d u v:float.

Let delta := (Rabs (d-(b*b'-a*c)))%R.

Hypothesis Fa : (Fbounded bo a).
Hypothesis Fb : (Fbounded bo b).
Hypothesis Fb': (Fbounded bo b').
Hypothesis Fc : (Fbounded bo c).
Hypothesis Fp : (Fbounded bo p).
Hypothesis Fq : (Fbounded bo q).
Hypothesis Fd : (Fbounded bo d).
Hypothesis Ft : (Fbounded bo t).
Hypothesis Fs : (Fbounded bo s).
Hypothesis Fdp: (u<v)%R -> (Fbounded bo dp).
Hypothesis Fdq: (u<v)%R -> (Fbounded bo dq).

Hypotheses Cv: Fcanonic radix bo v.
Hypothesis Cs:(Fcanonic radix bo s).

(** There is no underflow *)
Hypothesis U1: (- dExp bo <= (Fexp t)-1)%Z.
Hypothesis U2: (powerRZ radix (-dExp bo+2*precision-1) <= Rabs (b*b'))%R.
Hypothesis U3: (powerRZ radix (-dExp bo+2*precision-1) <= Rabs (a*c))%R.

Hypothesis Np:(Fnormal radix bo p).
Hypothesis Nq:(Fnormal radix bo q).
Hypothesis Nd:(Fnormal radix bo d).
Hypothesis Nt:(Fnormal radix bo t).
Hypothesis Nu:(Fnormal radix bo u).
Hypothesis Nv:(Fnormal radix bo v).

Hypothesis Square:(0 <=b*b')%R.

Hypothesis Roundp : (EvenClosest bo radix precision (b*b')%R p).
Hypothesis Roundq : (EvenClosest bo radix precision (a*c)%R q).
Hypothesis Roundu : (EvenClosest bo radix precision (3*Rabs t)%R u).
Hypothesis Roundv : (EvenClosest bo radix precision (p+q)%R v).

Hypothesis Case1 : (p+q <= 3*(Rabs (p-q)))%R.
Hypothesis Case2 : (u < v )%R.


Hypothesis Roundt : (EvenClosest bo radix precision (p-q)%R t).
Hypothesis dpEq   : (FtoRradix dp=b*b'-p)%R.
Hypothesis dqEq   : (FtoRradix dq=a*c-q)%R.
Hypothesis Rounds : (EvenClosest bo radix precision (dp-dq)%R s).
Hypothesis Roundd : (EvenClosest bo radix precision (t+s)%R d).

Theorem RoundGeNormal: forall f:float, forall r:R,
  Closest bo radix r f -> (Fnormal radix bo f) ->
  (Rabs r <= Rabs f * (1 + powerRZ radix (- precision)))%R.
intros.
apply Rplus_le_reg_l with (-Rabs f)%R.
apply Rle_trans with (Rabs r-Rabs f)%R;[right; ring|idtac].
apply Rle_trans with (Rabs f * powerRZ radix (- precision) )%R;[idtac|right; ring].
apply Rle_trans with (Rabs (r-f));[apply Rabs_triang_inv|idtac].
apply Rmult_le_reg_l with (INR 2); auto with real.
apply Rle_trans with (Fulp bo radix precision f).
unfold FtoRradix; apply ClosestUlp; auto.
apply Rle_trans with (Rabs f*powerRZ radix (Zsucc (-precision)))%R.
unfold FtoRradix; apply FulpLe2; auto.
elim H0; auto.
rewrite FcanonicFnormalizeEq; auto with zarith.
left; auto.
right; unfold Zsucc; rewrite powerRZ_add; auto with real zarith; simpl; ring.
Qed.



Theorem discri12:  (q <= p)%R -> (delta <= 2*(Fulp bo radix precision d))%R.
intros M.
assert (0 < 3)%R.
apply Rlt_le_trans with 2%R; auto with real.
assert (0 <= p-q)%R.
apply Rplus_le_reg_l with q.
ring_simplify; auto.
assert (0 <= p)%R.
apply P_positive with bo precision b b'; auto.
assert (0 < (1 - powerRZ radix (- precision)))%R; auto with real.
apply Rplus_lt_reg_r with (powerRZ radix (- precision)).
ring_simplify.
replace 1%R with (powerRZ radix 0);
    [ auto with real zarith | simpl in |- *; auto ].
assert (p-q <= Rsqr (1+powerRZ radix (-precision))/(1-powerRZ radix (-precision))*/3*(p+Rabs q))%R.
apply Rle_trans with (Rabs (p-q));[apply RRle_abs|idtac].
apply Rle_trans with (Rabs t * (1 + powerRZ radix (- precision)))%R.
apply RoundGeNormal; auto.
elim Roundt; auto.
apply Rle_trans with (((((p + Rabs q)/(1 - powerRZ radix (- precision)))
 * (1 + powerRZ radix (- precision)))*/3)* (1 + powerRZ radix (- precision)))%R;
  [idtac|right; unfold Rdiv, Rsqr; ring].
apply Rmult_le_compat_r; auto with real.
apply Rle_trans with (0+0)%R; try apply Rplus_le_compat; auto with real zarith.
apply Rle_trans with ((3*Rabs t)*/3)%R;
  [right; field; auto with real| apply Rmult_le_compat_r; auto with real].
apply Rle_trans with (Rabs (3*Rabs t));[apply RRle_abs|idtac].
apply Rle_trans with (Rabs u * (1 + powerRZ radix (- precision)))%R.
apply RoundGeNormal; auto; elim Roundu; auto.
apply Rmult_le_compat_r; auto with real.
apply Rle_trans with (0+0)%R; try apply Rplus_le_compat; auto with real zarith.
apply Rle_trans with (Rabs v).
cut (0 <= u)%R.
intros; repeat rewrite Rabs_right; auto with real.
apply Rle_ge; apply Rle_trans with (FtoRradix u); auto with real.
unfold FtoRradix; apply RleRoundedR0 with bo precision 
  (EvenClosest bo radix precision) (3 * Rabs t)%R; auto with zarith float.
apply Rle_trans with(3*0)%R; auto with real; apply Rmult_le_compat; auto with real.
apply Rle_trans with  (Rabs (p+q) / (1 - powerRZ radix (- precision)))%R.
unfold FtoRradix; apply RoundLeNormal with bo; auto with zarith float real.
elim Roundv; auto.
unfold Rdiv; apply Rmult_le_compat_r; auto with real.
apply Rle_trans with (Rabs p+Rabs q)%R;[apply Rabs_triang|idtac].
apply Rplus_le_compat_r; rewrite Rabs_right; auto with real.
case (Rle_or_lt q 0); intros.
absurd (p <= q)%R.
apply Rlt_not_le; case M; auto with real.
intros; absurd (0 < v)%R.
apply Rle_not_lt.
unfold FtoRradix; apply RleRoundedLessR0 with  bo precision 
  (EvenClosest bo radix precision) (p+q)%R; auto with zarith float.
apply Rle_trans with (1:=Case1); rewrite H5.
right; ring_simplify (p-p)%R; rewrite Rabs_R0; ring.
apply Rle_lt_trans with (FtoRradix u); auto with real.
unfold FtoRradix; apply RleRoundedR0 with bo precision 
  (EvenClosest bo radix precision) (3 * Rabs t)%R; auto with zarith float.
apply Rle_trans with(3*0)%R; auto with real; apply Rmult_le_compat; auto with real.
apply Rmult_le_reg_l with (1- Rsqr (1 + powerRZ radix (- precision)) /
        (1 - powerRZ radix (- precision)) * / 3)%R.
apply Rplus_lt_reg_r with  (Rsqr (1 + powerRZ radix (- precision)) /
    (1 - powerRZ radix (- precision)) * / 3)%R.
ring_simplify.
apply Rmult_lt_reg_l with 3%R; auto with real.
apply Rmult_lt_reg_l with (1 - powerRZ radix (- precision))%R; auto with real.
apply Rle_lt_trans with (Rsqr (1 + powerRZ radix (- precision)));
  [right; field; auto with real|ring_simplify (3*1)%R].
apply Rplus_lt_reg_r with (-1+3*powerRZ radix (- precision))%R.
apply Rle_lt_trans with (5* powerRZ radix (- precision)
  + powerRZ radix (- precision)* powerRZ radix (- precision))%R;[right; unfold Rsqr; ring|idtac].
apply Rlt_le_trans with 2%R;[idtac|right; ring].
apply Rlt_le_trans with  (5 * powerRZ radix (- precision) +
    3*powerRZ radix (- precision))%R;
   [apply Rplus_lt_compat_l; apply Rmult_lt_compat_r; auto with real zarith|idtac].
apply Rle_lt_trans with (powerRZ radix 1); auto with real zarith.
simpl; ring_simplify (2*1)%R; auto with real.
apply Rle_trans with  (8 * powerRZ radix (- precision))%R;[right; ring|idtac].
replace 8%R with (powerRZ radix 3);[idtac|simpl; ring].
replace 2%R with (powerRZ radix 1);[idtac|simpl; ring].
rewrite <- powerRZ_add; auto with real zarith.
apply Rplus_le_reg_l with (-q+ ((Rsqr (1 + powerRZ radix (- precision)) /
     (1 - powerRZ radix (- precision)) * / 3) * p))%R.
apply Rle_trans with (p-q)%R;[right; ring|idtac].
apply Rle_trans with (1:=H3).
apply Rle_trans with  (Rsqr (1 + powerRZ radix (- precision)) /
    (1 - powerRZ radix (- precision)) * / 3 * (p - q))%R;
    [idtac|right; ring].
replace (Rabs q) with (-q)%R;[right; ring|rewrite Rabs_left1; auto with real].
assert (forall f1:float, forall f2:float, forall i:Z, 
      (0 <= i)%Z
   ->  Fbounded bo f1 -> Fnormal radix bo f2
   -> (Rabs f1 <= powerRZ radix i*Rabs f2)%R
   -> (Fulp bo radix precision f1 <= powerRZ radix i*Fulp bo radix precision f2)%R).
intros.
rewrite CanonicFulp with bo radix precision f2; auto with zarith float.
2: left; auto.
unfold FtoR; simpl; ring_simplify ((1 * powerRZ 2 (Fexp f2)))%R.
unfold Fulp; rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
apply Zle_trans with (Fexp (Float (Fnum f2) (i + Fexp f2))); auto with zarith.
apply Fcanonic_Rle_Zle with radix bo precision; auto with real zarith.
apply FnormalizeCanonic; auto with real zarith.
elim H7; intros Y1 Y2; elim Y1; intros Y3 Y4.
left; split; try split; simpl; auto with zarith.
rewrite FnormalizeCorrect; auto with real zarith.
fold FtoRradix; apply Rle_trans with (1:=H8).
unfold FtoRradix; repeat rewrite <- Fabs_correct; auto.
unfold FtoR, Rabs; simpl.
rewrite powerRZ_add; auto with real zarith; right; ring.
assert (2*q <= p)%R.
apply Rmult_le_reg_l with 2%R; auto with real.
apply Rplus_le_reg_l with (-3*q+p)%R.
apply Rle_trans with (p+q)%R;[right; ring|apply Rle_trans with (1:=Case1)].
rewrite Rabs_right;[right; ring|apply Rle_ge; auto with real].
assert (q <= t)%R.
apply Rle_trans with (Rabs t);[idtac|rewrite Rabs_right; auto with real].
2:unfold FtoRradix; apply Rle_ge; apply RleRoundedR0 with bo precision 
  (EvenClosest bo radix precision) (p-q)%R; auto with zarith float.
unfold FtoRradix; apply RoundAbsMonotonel with bo precision 
   (EvenClosest bo radix precision) (p-q)%R; auto with zarith float.
fold FtoRradix; rewrite Rabs_right;[idtac|apply Rle_ge]; auto with real.
apply Rplus_le_reg_l with q; ring_simplify (q+(p-q))%R.
apply Rle_trans with (2*q)%R; auto with real; right; ring.
assert (Rabs s <= 3*Fulp bo radix precision q)%R.
assert (exists f:float, Fbounded bo f /\ (FtoRradix f= 3 * Fulp bo radix precision q)%R).
exists (Float 3 (Fexp q)).
split;[split; simpl; auto with zarith|idtac].
apply Zlt_le_trans with (Zpower_nat radix 2); auto with zarith.
rewrite pGivesBound; auto with zarith.
auto with zarith float.
rewrite CanonicFulp; auto with real zarith.
2: left; auto.
unfold FtoRradix, FtoR; simpl; ring.
elim H8; intros f T; elim T; intros; clear T H8.
rewrite <- H10.
unfold FtoRradix; apply RoundAbsMonotoner with bo precision 
   (EvenClosest bo radix precision) (dp-dq)%R; auto with zarith float.
fold FtoRradix; unfold Rminus; apply Rle_trans with (Rabs dp+Rabs (-dq))%R;
   [apply Rabs_triang|rewrite Rabs_Ropp].
apply Rmult_le_reg_l with (INR 2); auto with real.
apply Rle_trans with ((INR 2)*Rabs dp+(INR 2)*Rabs dq)%R;[right; ring|idtac].
apply Rle_trans with (Fulp bo radix precision p+Fulp bo radix precision q)%R;
   [apply Rplus_le_compat|idtac].
rewrite dpEq; unfold FtoRradix; apply ClosestUlp; auto with zarith.
elim Roundp; auto.
rewrite dqEq; unfold FtoRradix; apply ClosestUlp; auto with zarith.
elim Roundq; auto.
apply Rle_trans with  (5*Fulp bo radix precision q+Fulp bo radix precision q)%R;
  [apply Rplus_le_compat_r|rewrite H10; simpl; right; ring].
apply Rle_trans with  (powerRZ radix 2*Fulp bo radix precision q)%R;
  [idtac|apply Rmult_le_compat_r; auto with real zarith].
2: unfold Fulp; auto with real zarith.
2: simpl; ring_simplify (2*1)%R; apply Rle_trans with (4+1)%R; auto with real.
apply H5; auto with zarith.
apply Rle_trans with  (3*Rabs q)%R;
  [idtac|apply Rmult_le_compat_r; auto with real zarith].
2:  simpl; ring_simplify (2*1)%R;  apply Rle_trans with (3+1)%R; auto with real; right; ring.
apply Rmult_le_reg_l with (/2)%R; auto with real.
apply Rplus_le_reg_l with (/2*Rabs p)%R.
apply Rle_trans with (Rabs p);[right; field; auto with real|idtac].
rewrite Rabs_right;auto with real.
apply Rle_trans with (/2*(p+Rabs q) +Rabs q)%R;[idtac|right; field; auto with real].
apply Rle_trans with ((p-q)+Rabs q)%R.
rewrite Rabs_right; [right; ring|apply Rle_ge;auto with real].
apply Rplus_le_compat_r.
apply Rle_trans with (1:=H3).
apply Rmult_le_compat_r; auto with real.
apply Rle_trans with (0+0)%R; try apply Rplus_le_compat; auto with real.
apply Rmult_le_reg_l with 2%R; auto with real.
apply Rmult_le_reg_l with 3%R; auto with real.
apply Rmult_le_reg_l with (1 - powerRZ radix (- precision))%R; auto with real.
apply Rle_trans with (Rsqr (1 + powerRZ radix (- precision))*2)%R;
  [right; field; auto with real|idtac].
apply Rle_trans with (3*(1 - powerRZ radix (- precision)))%R;[idtac|right; field; auto with real].
apply Rplus_le_reg_l with (-2+3*powerRZ radix (- precision))%R.
apply Rle_trans with (7*powerRZ radix (- precision)
  +2*powerRZ radix (- precision)*powerRZ radix (- precision))%R;[right; unfold Rsqr; ring|idtac].
apply Rle_trans with 1%R;[idtac|right; ring].
apply Rle_trans with (7 * powerRZ radix (- precision) + powerRZ radix (- precision))%R;
   [apply Rplus_le_compat_l|idtac].
replace 2%R with (powerRZ radix 1); auto with real zarith.
repeat rewrite <- powerRZ_add; auto with real zarith.
apply Rle_trans with (powerRZ radix 3 * powerRZ radix (- precision))%R;
  [right; simpl; ring|idtac].
rewrite <- powerRZ_add; auto with real zarith.
apply Rle_trans with (powerRZ radix 0); auto with real zarith.
assert (t-3*Fulp bo radix precision t <= Rabs d)%R.
assert (exists f:float, Fbounded bo f /\ 
   (FtoRradix f= t-3 * Fulp bo radix precision t)%R).
exists (Float (Fnum t-3) (Fexp t)).
split;[split; simpl; auto with zarith|idtac].
assert (0 < Fnum t)%Z;[apply LtR0Fnum with radix; auto with real zarith|idtac].
fold FtoRradix; apply Rlt_le_trans with q; auto.
case (Zle_or_lt 0 (Fnum t-3)%Z); intros.
rewrite Zabs_eq; auto.
apply Zle_lt_trans with (Zabs (Fnum t)); auto with zarith float.
rewrite Zabs_eq; auto with zarith.
rewrite <- Zabs_Zopp; rewrite Zabs_eq; auto with zarith.
apply Zlt_le_trans with 3%Z; auto with zarith.
apply Zle_trans with (nNormMin radix precision); auto with zarith.
unfold nNormMin; apply Zle_trans with (Zpower_nat radix 2); auto with zarith.
apply nNrMMimLevNum; auto with zarith.
rewrite CanonicFulp; auto with zarith.
2: left; auto.
unfold FtoRradix, FtoR, Zminus; simpl; rewrite plus_IZR; simpl; ring.
elim H9; intros f T; elim T; intros; clear H9 T.
rewrite <- H11.
unfold FtoRradix; apply RoundAbsMonotonel with bo precision 
   (EvenClosest bo radix precision) (t+s)%R; auto with zarith float.
fold FtoRradix; replace (t+s)%R with (t-(-s))%R;[idtac|ring].
apply Rle_trans with (Rabs t -Rabs (-s))%R;[idtac|apply Rabs_triang_inv].
rewrite Rabs_Ropp; rewrite Rabs_right.
rewrite H11; unfold Rminus; apply Rplus_le_compat_l; auto with real.
apply Ropp_le_contravar; apply Rle_trans with (1:=H8).
apply Rmult_le_compat_l; auto with real.
apply LeFulpPos; auto with real.
apply Rle_ge; apply Rle_trans with q; auto with real.
assert (Fulp bo radix precision t <= 2*Fulp bo radix precision d)%R.
replace 2%R with (powerRZ radix 1); auto with real zarith.
apply H5; auto with zarith.
apply Rmult_le_reg_l with (/2)%R; auto with real.
apply Rle_trans with (Rabs d);[idtac|right; simpl; field; auto with real].
apply Rle_trans with (2:=H9).
rewrite Rabs_right;[idtac|apply Rle_ge; apply Rle_trans with q; auto with real].
apply Rle_trans with (t-t/2)%R;[right; field; auto with real|idtac].
unfold Rminus; apply Rplus_le_compat_l; apply Ropp_le_contravar.
apply Rle_trans with (3*(Rabs (FtoR radix t) * powerRZ radix (Zsucc (- precision))))%R.
apply Rmult_le_compat_l; auto with real. 
apply FulpLe2; auto with real zarith float.
rewrite FcanonicFnormalizeEq; auto with zarith float.
left; auto.
fold FtoRradix; apply Rle_trans with (Rabs t*(3*powerRZ radix  (Zsucc (- precision))))%R;
   [right; ring|idtac].
rewrite Rabs_right;[idtac|apply Rle_ge; apply Rle_trans with q; auto with real].
unfold Rdiv; apply Rmult_le_compat_l; auto with real.
apply Rle_trans with q; auto with real.
apply Rle_trans with (4*powerRZ radix  (Zsucc (- precision)))%R;
  [apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rle_trans with (3+1)%R; auto with real; right; ring.
replace 4%R with (powerRZ radix 2).
2: simpl; ring.
replace (/2)%R with (powerRZ radix (-1)).
2: simpl; ring_simplify (2*1)%R; auto with real.
rewrite <- powerRZ_add; auto with real zarith.
unfold Zsucc; apply Rle_powerRZ; auto with real zarith.
unfold delta.
replace (d-(b*b'-a*c))%R with
   (-((t+s)-d)+-((p-q)-t)+-((dp-dq)-s))%R;[idtac|rewrite dpEq; rewrite dqEq; ring].
apply Rle_trans with  (Rabs (- (t + s - d) + (- (p - q - t))) + Rabs (- (dp - dq - s)))%R;
  [apply Rabs_triang|rewrite Rabs_Ropp].
apply Rle_trans with  (Rabs (- (t + s - d)) + Rabs (- (p - q - t)) + Rabs ((dp - dq - s)))%R;
  [apply Rplus_le_compat_r; apply Rabs_triang|repeat rewrite Rabs_Ropp].
apply Rmult_le_reg_l with (INR 2); auto with real.
apply Rle_trans with ((INR 2)*Rabs ((t + s - d)) + (INR 2)*Rabs ((p - q - t)) 
   + (INR 2)*Rabs ((dp - dq - s)))%R;[right; ring|idtac].
apply Rle_trans with (Fulp bo radix precision d+Fulp bo radix precision t
  +Fulp bo radix precision s)%R;[apply Rplus_le_compat|idtac].
apply Rplus_le_compat.
unfold FtoRradix; apply ClosestUlp; auto with zarith float; elim Roundd; auto.
unfold FtoRradix; apply ClosestUlp; auto with zarith float; elim Roundt; auto.
unfold FtoRradix; apply ClosestUlp; auto with zarith float; elim Rounds; auto.
apply Rle_trans with (Fulp bo radix precision d + 2*Fulp bo radix precision d +
    Fulp bo radix precision s)%R; auto with real.
apply Rle_trans with (Fulp bo radix precision d + 2 * Fulp bo radix precision d +
    Fulp bo radix precision d)%R;[idtac|right; simpl; ring].
apply Rplus_le_compat_l.
rewrite FulpFabs with bo radix precision s; auto.
rewrite FulpFabs with bo radix precision d; auto.
apply LeFulpPos; auto with zarith real float.
rewrite Fabs_correct; auto with real zarith.
repeat rewrite Fabs_correct; auto; fold FtoRradix.
apply Rle_trans with (1:=H8); apply Rle_trans with (2:=H9).
apply Rle_trans with (3 * Fulp bo radix precision t)%R.
apply Rmult_le_compat_l; auto with real.
apply LeFulpPos; auto with zarith real float.
apply Rplus_le_reg_l with (3* Fulp bo radix precision t)%R.
ring_simplify (3 * Fulp bo radix precision t + (t - 3 * Fulp bo radix precision t))%R.
apply Rle_trans with (6*Fulp bo radix precision t)%R;[right; ring|idtac].
apply Rle_trans with (6*(Rabs (FtoR radix t) * powerRZ radix (Zsucc (- precision))))%R.
apply Rmult_le_compat_l; auto with real. 
apply Rle_trans with 3%R; auto with real.
apply FulpLe2; auto with real zarith float.
rewrite FcanonicFnormalizeEq; auto with zarith float.
left; auto.
fold FtoRradix; apply Rle_trans with (Rabs t*(6*powerRZ radix  (Zsucc (- precision))))%R;
   [right; ring|idtac].
rewrite Rabs_right;[idtac|apply Rle_ge; apply Rle_trans with q; auto with real].
apply Rle_trans with (t*1)%R; auto with real.
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with q; auto with real.
apply Rle_trans with (8*powerRZ radix  (Zsucc (- precision)))%R;
  [apply Rmult_le_compat_r; auto with real zarith|idtac].
apply Rmult_le_compat_l; auto with real.
apply Rle_trans with (3+1)%R; auto with real; right; ring.
replace 8%R with (powerRZ radix 3).
2: simpl; ring.
replace 1%R with (powerRZ radix 0).
2: simpl; auto with real.
rewrite <- powerRZ_add; auto with real zarith.
apply Rle_powerRZ; auto with real zarith.
Qed.
End Discriminant3.


Section Discriminant4.
Variable bo : Fbound.
Variable precision : nat.
 
Let radix := 2%Z.

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

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ TwoMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum bo) = Zpower_nat radix precision.
Hypothesis precisionGreaterThanFour : 4 <= precision.

Variables a b b' c p q t dp dq s d u v:float.

Let delta := (Rabs (d-(b*b'-a*c)))%R.

Hypothesis Fa : (Fbounded bo a).
Hypothesis Fb : (Fbounded bo b).
Hypothesis Fb': (Fbounded bo b').
Hypothesis Fc : (Fbounded bo c).
Hypothesis Fp : (Fbounded bo p).
Hypothesis Fq : (Fbounded bo q).
Hypothesis Fd : (Fbounded bo d).
Hypothesis Ft : (Fbounded bo t).
Hypothesis Fs : (Fbounded bo s).
Hypothesis Fdp: (u<v)%R -> (Fbounded bo dp).
Hypothesis Fdq: (u<v)%R -> (Fbounded bo dq).

Hypotheses Cv: Fcanonic radix bo v.
Hypotheses Cs: Fcanonic radix bo s.

(** There is no underflow *)
Hypothesis U1: (- dExp bo <= (Fexp t)-1)%Z.
Hypothesis U2: (powerRZ radix (-dExp bo+2*precision-1) <= Rabs (b*b'))%R.
Hypothesis U3: (powerRZ radix (-dExp bo+2*precision-1) <= Rabs (a*c))%R.



Hypothesis Np:(Fnormal radix bo p).
Hypothesis Nq:(Fnormal radix bo q).
Hypothesis Nd:(Fnormal radix bo d).
Hypothesis Nt:(Fnormal radix bo t).
Hypothesis Nu:(Fnormal radix bo u).
Hypothesis Nv:(Fnormal radix bo v).

Hypothesis Square:(0 <=b*b')%R.

Hypothesis Roundp : (EvenClosest bo radix precision (b*b')%R p).
Hypothesis Roundq : (EvenClosest bo radix precision (a*c)%R q).
Hypothesis Roundu : (EvenClosest bo radix precision (3*Rabs t)%R u).
Hypothesis Roundv : (EvenClosest bo radix precision (p+q)%R v).

Hypothesis Case1 : (p+q <= 3*(Rabs (p-q)))%R.
Hypothesis Case2 : (u < v )%R.


Hypothesis Roundt : (EvenClosest bo radix precision (p-q)%R t).
Hypothesis dpEq   : (FtoRradix dp=b*b'-p)%R.
Hypothesis dqEq   : (FtoRradix dq=a*c-q)%R.
Hypothesis Rounds : (EvenClosest bo radix precision (dp-dq)%R s).
Hypothesis Roundd : (EvenClosest bo radix precision (t+s)%R d).

Theorem discri13: (delta <= 2*(Fulp bo radix precision d))%R.
case (Rle_or_lt q p); intros.
unfold delta, FtoRradix; apply discri12 with p q t dp dq s u v; auto with zarith.
case (Rle_or_lt 0%R (a*c)%R)%R; intros.
unfold delta.
replace (d - (b * b' - a * c))%R with (-(Fopp d-(a*c-b*b')))%R;unfold FtoRradix;
  [idtac|rewrite Fopp_correct; ring].
rewrite Rabs_Ropp; apply Rle_trans with  (2 * Fulp bo radix precision (Fopp d))%R.
generalize (EvenClosestSymmetric bo radix precision); unfold SymmetricP; intros L.
apply discri12 with q p (Fopp t) dq dp (Fopp s) u v; auto with real float zarith.
apply FnormalFop; auto.
apply FnormalFop; auto.
rewrite Fopp_correct; rewrite Rabs_Ropp; auto.
rewrite Rplus_comm; auto.
rewrite Rplus_comm; fold radix; fold FtoRradix; 
  replace (q-p)%R with (-(p-q))%R;[rewrite Rabs_Ropp|ring]; auto with real.
fold radix; fold FtoRradix; replace (q-p)%R with (-(p-q))%R;[apply L; auto|ring].
fold radix; fold FtoRradix; replace (dq-dp)%R with (-(dp-dq))%R;[apply L; auto|ring].
repeat rewrite Fopp_correct; fold radix; fold FtoRradix.
replace (-t+-s)%R with (-(t+s))%R;[apply L; auto|ring].
unfold Fulp; rewrite Fnormalize_Fopp; unfold Fopp; simpl; auto with real zarith.
absurd (0<q)%R.
apply Rle_not_lt; unfold FtoRradix.
apply RleRoundedLessR0 with bo precision (EvenClosest bo radix precision) (a*c)%R; 
  auto with real zarith float.
apply Rle_lt_trans with p; auto with real.
apply P_positive with bo precision b b'; auto.
Qed.



End Discriminant4.

Section Discriminant5.
Variable bo : Fbound.
Variable precision : nat.
 
Let radix := 2%Z.

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

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ TwoMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum bo) = Zpower_nat radix precision.
Hypothesis precisionGreaterThanFour : 4 <= precision.

Variables a b c p q t dp dq s d u v:float.

Let delta := (Rabs (d-(b*b-a*c)))%R.

Hypothesis Fa : (Fbounded bo a).
Hypothesis Fb : (Fbounded bo b).
Hypothesis Fc : (Fbounded bo c).
Hypothesis Fp : (Fbounded bo p).
Hypothesis Fq : (Fbounded bo q).
Hypothesis Fd : (Fbounded bo d).
Hypothesis Ft : (Fbounded bo t).
Hypothesis Fs : (u<v)%R -> (Fbounded bo s).
Hypothesis Fdp: (u<v)%R -> (Fbounded bo dp).
Hypothesis Fdq: (u<v)%R -> (Fbounded bo dq).
Hypothesis Fu: (Fbounded bo u).
Hypothesis Fv: (Fbounded bo v).
Hypothesis Cs: (u < v)%R -> (Fcanonic radix bo s).

(** There is no underflow *)
Hypothesis U0: (- dExp bo <= Fexp d - 1)%Z.
Hypothesis U1: (- dExp bo <= (Fexp t)-1)%Z.
Hypothesis U2: (powerRZ radix (-dExp bo+2*precision-1) <= Rabs (b*b))%R.
Hypothesis U3: (powerRZ radix (-dExp bo+2*precision-1) <= Rabs (a*c))%R.



Hypothesis Np:(Fnormal radix bo p).
Hypothesis Nq:(Fnormal radix bo q).
Hypothesis Nd:(Fnormal radix bo d).
Hypothesis Nu:(Fnormal radix bo u).
Hypothesis Nv:(Fnormal radix bo v).
Hypothesis Nt:(Fnormal radix bo t).

Hypothesis Roundp : (EvenClosest bo radix precision (b*b)%R p).
Hypothesis Roundq : (EvenClosest bo radix precision (a*c)%R q).
Hypothesis Roundt : (EvenClosest bo radix precision (p-q)%R t).
Hypothesis Roundu : (EvenClosest bo radix precision (3*Rabs t)%R u).
Hypothesis Roundv : (EvenClosest bo radix precision (p+q)%R v).


Hypothesis FRoundd : (v <= u)%R -> 
   (EvenClosest bo radix precision (p-q)%R d).

Hypothesis dpEq   : (FtoRradix dp=b*b-p)%R.
Hypothesis dqEq   : (FtoRradix dq=a*c-q)%R.
Hypothesis SRounds : (u < v)%R -> (EvenClosest bo radix precision (dp-dq)%R s).
Hypothesis SRoundd : (u < v)%R -> (EvenClosest bo radix precision (t+s)%R d).

Theorem discri14: (delta <= 2*(Fulp bo radix precision d))%R.
case (Rle_or_lt (p+q)%R (3*(Rabs (p-q)))%R); case (Rle_or_lt v u); intros.
unfold delta, FtoRradix.
apply discri9 with p q t dp dq s; auto;
  fold radix; fold FtoRradix; intros;
  absurd (p + q <= 3 * Rabs (p - q))%R; auto with real.
unfold delta, FtoRradix.
apply discri13 with p q t dp dq s u v; auto.
apply Rle_trans with (Rsqr (FtoR 2 b)); auto with real.
unfold delta, FtoRradix.
apply discri11 with p q t u v dp dq; auto with zarith.
left; auto.
assert (exists s : float,
         Fbounded bo s /\
         FtoR 2 s = (FtoR 2 b * FtoR 2 b - FtoR 2 p)%R /\
         Fexp s = (Fexp p - precision)%Z /\
         (Rabs (Fnum s) <= powerRZ (Zpos 2) (Zpred precision))%R).
apply errorBoundedMultClosest_Can; auto.
elim Roundp; auto.
left; auto.
elim H1; intros s' T; elim T; intros T1 T2; elim T2; intros T3 T4; elim T4; intros.
apply Zle_trans with (Fexp s')%Z; auto with zarith float.
assert (exists s : float,
         Fbounded bo s /\
         FtoR 2 s = (FtoR 2 a * FtoR 2 c - FtoR 2 q)%R /\
         Fexp s = (Fexp q - precision)%Z /\
         (Rabs (Fnum s) <= powerRZ (Zpos 2) (Zpred precision))%R).
apply errorBoundedMultClosest_Can; auto.
elim Roundq; auto.
left; auto.
elim H1; intros s' T; elim T; intros T1 T2; elim T2; intros T3 T4; elim T4; intros.
apply Zle_trans with (Fexp s')%Z; auto with zarith float.
fold FtoRradix; apply Rle_trans with (Rsqr b); auto with real.
apply FcanonicUnique with radix bo precision; auto with zarith.
left; auto.
left; auto.
generalize EvenClosestUniqueP; unfold UniqueP; intros Y.
apply Y with bo precision (p-q)%R; auto with real zarith.
unfold delta, FtoRradix.
apply discri9 with p q t dp dq s; auto.
fold radix; fold FtoRradix; intros.
absurd (p + q <= 3 * Rabs (p - q))%R; auto with real.
Qed.


End Discriminant5.

Section Discriminant6.
Variable bo : Fbound.
Variable precision : nat.
 
Let radix := 2%Z.

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

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ TwoMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum bo) = Zpower_nat radix precision.
Hypothesis precisionGreaterThanFour : 4 <= precision.

Variables a b c p q t dp dq s d u v:float.

Let delta := (Rabs (d-(b*b-a*c)))%R.

Hypothesis Fa : (Fbounded bo a).
Hypothesis Fb : (Fbounded bo b).
Hypothesis Fc : (Fbounded bo c).
Hypothesis Fdp: (u<v)%R -> (Fbounded bo dp).
Hypothesis Fdq: (u<v)%R -> (Fbounded bo dq).

(** There is no underflow *)

Hypothesis U1: (powerRZ radix (-dExp bo+2*precision-1) <= Rabs (b*b))%R.
Hypothesis U2: (powerRZ radix (-dExp bo+2*precision-1) <= Rabs (a*c))%R.
Hypothesis U4: (powerRZ radix (-dExp bo+precision) <= Rabs d)%R.
Hypothesis U5: (powerRZ radix (-dExp bo+precision-1) <= Rabs u)%R.
Hypothesis U6: (powerRZ radix (-dExp bo+precision-1) <= Rabs v)%R.
Hypothesis U7: (powerRZ radix (-dExp bo+precision) <= Rabs t)%R.

Hypothesis Roundp : (EvenClosest bo radix precision (b*b)%R p).
Hypothesis Roundq : (EvenClosest bo radix precision (a*c)%R q).
Hypothesis Roundt : (EvenClosest bo radix precision (p-q)%R t).
Hypothesis Roundu : (EvenClosest bo radix precision (3*Rabs t)%R u).
Hypothesis Roundv : (EvenClosest bo radix precision (p+q)%R v).


Hypothesis FRoundd : (v <= u)%R -> 
   (EvenClosest bo radix precision (p-q)%R d).

Hypothesis dpEq   : (FtoRradix dp=b*b-p)%R.
Hypothesis dqEq   : (FtoRradix dq=a*c-q)%R.
Hypothesis SRounds : (u < v)%R -> (EvenClosest bo radix precision (dp-dq)%R s).
Hypothesis SRoundd : (u < v)%R -> (EvenClosest bo radix precision (t+s)%R d).

Theorem discri15: (delta <= 2*(Fulp bo radix precision d))%R.
assert  (forall r:R, forall f:float,
  EvenClosest bo radix precision r f -> Fbounded bo f).
intros r f T; elim T; intros T1 T2; elim T1; auto with zarith float.
assert (forall f:float,  (Fbounded bo f) -> 
  (powerRZ radix (- dExp bo + precision - 1) <= Rabs f)%R
  -> Fnormal radix bo (Fnormalize radix bo precision f)).
intros.
assert (Fcanonic radix bo (Fnormalize radix bo precision f)).
apply FnormalizeCanonic; auto with zarith.
case H2; auto; intros.
absurd (FtoR radix (Fabs f) < FtoR radix (firstNormalPos radix bo precision))%R.
apply Rle_not_lt; rewrite Fabs_correct; auto.
fold FtoRradix; apply Rle_trans with (2:=H1).
unfold firstNormalPos, FtoRradix, FtoR, nNormMin; simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred; auto with zarith; unfold Zpred.
unfold Zminus; repeat rewrite powerRZ_add; auto with real zarith.
right; simpl; ring.
apply Rle_lt_trans with  (FtoR radix (Fabs  (Fnormalize radix bo precision f))).
repeat rewrite Fabs_correct; auto.
rewrite FnormalizeCorrect; auto with zarith real.
apply FsubnormalLtFirstNormalPos; auto with zarith.
apply FsubnormFabs; auto.
 rewrite Fabs_correct; auto with zarith real.
unfold delta; unfold FtoRradix.
assert (Fbounded bo d).
case (Rle_or_lt v u); intros.
elim FRoundd; auto; intros T T'; elim T; auto with zarith float.
elim SRoundd; auto; intros T T'; elim T; auto with zarith float.
apply Rle_trans with (2 * Fulp bo radix precision 
  (Fnormalize radix bo precision d))%R.
2: unfold Fulp; rewrite FcanonicFnormalizeEq with radix bo 
  precision (Fnormalize radix bo precision d); auto with zarith float real.
rewrite <- FnormalizeCorrect with radix bo precision d; auto with zarith.
assert (Fnormal radix bo (Fnormalize radix bo precision d)).
apply H0; auto.
apply Rle_trans with (2:=U4); auto with real zarith.
assert (Fnormal radix bo (Fnormalize radix bo precision t)).
apply H0.
apply H with (p-q)%R; auto.
apply Rle_trans with (2:=U7); auto with real zarith.
apply discri14 with (Fnormalize radix bo precision p)
  (Fnormalize radix bo precision q) (Fnormalize radix bo precision t)
  dp dq (Fnormalize radix bo precision s) (Fnormalize radix bo precision u)
  (Fnormalize radix bo precision v); auto.
apply FnormalizeBounded; auto with zarith float; apply H with (b*b)%R; auto.
apply FnormalizeBounded; auto with zarith float; apply H with (a*c)%R; auto.
apply FnormalizeBounded; auto with zarith float.
apply FnormalizeBounded; auto with zarith float; apply H with (p-q)%R; auto.
repeat rewrite FnormalizeCorrect; auto with real zarith; intros.
apply FnormalizeBounded; auto with zarith float; apply H with (dp-dq)%R; auto.
repeat rewrite FnormalizeCorrect; auto with real zarith.
repeat rewrite FnormalizeCorrect; auto with real zarith.
apply FnormalizeBounded; auto with zarith float; apply H with (3*Rabs t)%R; auto.
apply FnormalizeBounded; auto with zarith float; apply H with (p+q)%R; auto.
intros; apply FnormalizeCanonic; auto with zarith.
apply H with (dp-dq)%R; auto.
apply SRounds.
rewrite FnormalizeCorrect in H4; auto with zarith real.
rewrite FnormalizeCorrect in H4; auto with zarith real.
assert (- dExp bo + precision < Fexp (Fnormalize radix bo precision d) 
  + precision)%Z; auto with zarith.
apply Zlt_powerRZ with radix; auto with real zarith.
apply Rle_lt_trans with (1:=U4).
unfold FtoRradix; rewrite <- FnormalizeCorrect with radix bo precision d; 
  auto with zarith.
rewrite <- Fabs_correct; auto; unfold FtoR, Fabs; simpl.
rewrite Rmult_comm; rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_l; auto with real zarith.
apply Rlt_le_trans with (Zpos (vNum bo)); auto with zarith real float.
rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real zarith.
assert (- dExp bo + precision < Fexp (Fnormalize radix bo precision t) 
  + precision)%Z; auto with zarith.
apply Zlt_powerRZ with radix; auto with real zarith.
apply Rle_lt_trans with (1:=U7).
unfold FtoRradix; rewrite <- FnormalizeCorrect with radix bo precision t; 
  auto with zarith.
rewrite <- Fabs_correct; auto; unfold FtoR, Fabs; simpl.
rewrite Rmult_comm; rewrite powerRZ_add; auto with real zarith.
apply Rmult_lt_compat_l; auto with real zarith.
apply Rlt_le_trans with (Zpos (vNum bo)); auto with zarith real float.
assert (Fbounded bo (Fnormalize radix bo precision t)); 
  auto with zarith float real.
elim H3; auto.
rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real zarith.
apply H0; auto.
apply H with (b*b)%R; auto.
cut (exists f:float, Fbounded bo f /\ 
  (FtoRradix f=(powerRZ radix (- dExp bo + precision - 1)))%R).
intros T; elim T; intros f T'; elim T'; intros; clear T T'.
rewrite <- H5; unfold FtoRradix.
apply RoundAbsMonotonel with bo precision
  (Closest bo radix) (b*b)%R; auto with zarith float real.
apply ClosestRoundedModeP with precision; auto with zarith.
elim Roundp; auto.
fold FtoRradix; rewrite H5; auto.
apply Rle_trans with (2:=U1); auto with zarith real.
exists (Float 1 (-dExp bo+precision-1)).
split;[split|idtac].
simpl; apply vNumbMoreThanOne with radix precision; auto with zarith.
apply Zle_trans with (- dExp bo + precision - 1)%Z; auto with zarith.
unfold FtoRradix, FtoR; simpl; ring.
apply H0; auto.
apply H with (a*c)%R; auto.
cut (exists f:float, Fbounded bo f /\ 
  (FtoRradix f=(powerRZ radix (- dExp bo + precision - 1)))%R).
intros T; elim T; intros f T'; elim T'; intros; clear T T'.
rewrite <- H5; unfold FtoRradix.
apply RoundAbsMonotonel with bo precision
  (Closest bo radix) (a*c)%R; auto with zarith float real.
apply ClosestRoundedModeP with precision; auto with zarith.
elim Roundq; auto.
fold FtoRradix; rewrite H5; auto.
apply Rle_trans with (2:=U2); auto with zarith real.
exists (Float 1 (-dExp bo+precision-1)).
split;[split|idtac].
simpl; apply vNumbMoreThanOne with radix precision; auto with zarith.
apply Zle_trans with (- dExp bo + precision - 1)%Z; auto with zarith.
unfold FtoRradix, FtoR; simpl; ring.
apply H0; auto; apply H with (3*Rabs t)%R; auto.
apply H0; auto; apply H with (p+q)%R; auto.
generalize (EvenClosestCompatible bo radix precision); unfold CompatibleP.
intros T; apply T with (b*b)%R p; auto with real float zarith.
rewrite FnormalizeCorrect; auto with zarith real.
apply FnormalizeBounded; auto with zarith;apply H with (b*b)%R; auto.
generalize (EvenClosestCompatible bo radix precision); unfold CompatibleP.
intros T; apply T with (a*c)%R q; auto with real float zarith.
rewrite FnormalizeCorrect; auto with zarith real.
apply FnormalizeBounded; auto with zarith;apply H with (a*c)%R; auto.
repeat rewrite FnormalizeCorrect; auto with zarith real.
generalize (EvenClosestCompatible bo radix precision); unfold CompatibleP.
intros T; apply T with (p-q)%R t; auto with real float zarith.
rewrite FnormalizeCorrect; auto with zarith real.
apply FnormalizeBounded; auto with zarith;apply H with (p-q)%R; auto.
rewrite FnormalizeCorrect; auto with zarith real.
generalize (EvenClosestCompatible bo radix precision); unfold CompatibleP.
intros T; apply T with (3*Rabs t)%R u; auto with real float zarith.
rewrite FnormalizeCorrect; auto with zarith real.
apply FnormalizeBounded; auto with zarith;apply H with (3*Rabs t)%R; auto.
repeat rewrite FnormalizeCorrect; auto with zarith real.
generalize (EvenClosestCompatible bo radix precision); unfold CompatibleP.
intros T; apply T with (p+q)%R v; auto with real float zarith.
rewrite FnormalizeCorrect; auto with zarith real.
apply FnormalizeBounded; auto with zarith;apply H with (p+q)%R; auto.
repeat rewrite FnormalizeCorrect; auto with zarith real.
fold FtoRradix; intros.
generalize (EvenClosestCompatible bo radix precision); unfold CompatibleP.
intros T; apply T with (p-q)%R d; auto with real float zarith.
rewrite FnormalizeCorrect; auto with zarith real.
rewrite FnormalizeCorrect; auto with zarith real.
rewrite FnormalizeCorrect; auto with zarith real.
repeat rewrite FnormalizeCorrect; auto with zarith real.
fold FtoRradix; intros.
generalize (EvenClosestCompatible bo radix precision); unfold CompatibleP.
intros T; apply T with (dp-dq)%R s; auto with real float zarith.
rewrite FnormalizeCorrect; auto with zarith real.
apply FnormalizeBounded; auto with zarith;apply H with (dp-dq)%R; auto.
repeat rewrite FnormalizeCorrect; auto with zarith real.
fold FtoRradix; intros.
generalize (EvenClosestCompatible bo radix precision); unfold CompatibleP.
intros T; apply T with (t+s)%R d; auto with real float zarith.
rewrite FnormalizeCorrect; auto with zarith real.
Qed.

End Discriminant6.

Section Discriminant7.
Variable bo : Fbound.
Variable precision : nat.
 
Let radix := 2%Z.

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

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ TwoMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum bo) = Zpower_nat radix precision.
Hypothesis precisionGreaterThanFour : 4 <= precision.


Theorem FexpGeUnderf: forall e:Z, forall f:float,
  (Fbounded bo f) -> 
  ((powerRZ radix e) <= Rabs f)%R -> (e-precision+1 <= Fexp f)%Z.
intros.
assert (e < Fexp f+precision)%Z; auto with zarith.
apply Zlt_powerRZ with radix;auto with real zarith.
apply Rle_lt_trans with (1:=H0).
unfold FtoRradix; rewrite <- Fabs_correct; auto.
rewrite Zplus_comm; rewrite powerRZ_add; auto with real zarith.
unfold Fabs, FtoR; simpl.
apply Rmult_lt_compat_r; auto with real zarith.
apply Rlt_le_trans with (Zpos (vNum bo)); auto with zarith float real.
rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ; auto with real zarith.
Qed.



Theorem AddExpGeUnderf: forall f1:float ,forall f2:float, forall g:float, forall e:Z,
    Closest bo radix (f1+f2) g -> (Fbounded bo f1) -> (Fbounded bo f2)
      ->  (powerRZ radix e <= Rabs f1)%R
      ->  (powerRZ radix e <= Rabs f2)%R 
      ->  ((FtoRradix g=0)%R \/ (powerRZ radix (e-precision+1) <= Rabs g)%R).
intros.
case (Req_dec g 0); auto; intros.
right.
elim plusExactExp with bo radix precision f1 f2 g; auto with zarith.
intros s T; elim T; intros g' T'; elim T'; intros R1 T''; clear T T'.
elim T''; intros R2 T; elim T; intros R3 T'; elim T'; intros R4 TT; clear T T' T''.
elim TT; intros R5 T; elim T; intros R6 R7; clear T TT.
replace (FtoRradix g) with (FtoRradix g'); auto with real.
apply Rle_trans with (powerRZ radix (Fexp g')).
apply Rle_powerRZ; auto with real zarith.
apply Zle_trans with (Zmin (Fexp f1) (Fexp f2)); auto with zarith.
apply Zmin_Zle; apply FexpGeUnderf; auto.
unfold FtoRradix;  rewrite <- Fabs_correct; auto.
unfold Fabs, FtoR; simpl.
apply Rle_trans with (1%Z*powerRZ 2 (Fexp g'))%R;
  [simpl; right; ring|apply Rmult_le_compat_r; auto with real zarith].
case (Zle_lt_or_eq 0 (Zabs (Fnum g'))); auto with zarith real; intros.
case (Z_eq_dec 0 (Fnum g')); intros.
absurd (FtoR radix g=0)%R; auto with real.
rewrite <- R3; unfold FtoR; simpl; rewrite <- e0; simpl; ring.
absurd (0 <  Zabs (Fnum g'))%Z; auto with zarith.
apply Zlt_le_trans with (Zabs_nat (Fnum g')); auto with zarith.
assert  (0 < Zabs_nat (Fnum g')); auto with zarith arith.
apply absolu_lt_nz; auto.
rewrite Zabs_absolu; auto with zarith.
Qed.

Theorem AddExpGeUnderf2: forall f1:float ,forall f2:float, forall g:float, forall e:Z,
    Closest bo radix (f1+f2) g -> (Fbounded bo f1) -> (Fbounded bo f2)
      ->  (powerRZ radix e <= Rabs f1)%R
      ->  (powerRZ radix e <= Rabs f2)%R 
      ->  (FtoRradix g <>0)%R 
      -> (powerRZ radix (e-precision+1) <= Rabs g)%R.
intros.
case (AddExpGeUnderf f1 f2 g e); auto.
intros; absurd (FtoRradix g=0); auto with real.
Qed.

Theorem AddExpGe1Underf: forall f1:float ,forall f2:float, forall g:float, forall e:Z,
    Closest bo radix (f1+f2) g -> (Fcanonic radix bo f1) -> (Fcanonic radix bo f2)
      ->  (powerRZ radix e <= Rabs f1)%R
      ->  (-dExp bo <= e-1)%Z
      ->  ((FtoRradix g=0)%R \/ (powerRZ radix (e-precision) <= Rabs g)%R).
intros.
assert (F1:(Fbounded bo f1));[apply FcanonicBound with radix; auto|idtac].
assert (F2:(Fbounded bo f2));[apply FcanonicBound with radix; auto|idtac].
case (Req_dec g 0); auto; intros.
right.
case (Rle_or_lt (Rabs f1) (Rabs f2)); intros.
apply Rle_trans with (powerRZ radix (e-precision+1)).
apply Rle_powerRZ; auto with real zarith.
apply AddExpGeUnderf2 with f1 f2; auto with real.
apply Rle_trans with (1:=H2); auto with real.
case (Rle_or_lt (Rabs f2) ((Rabs f1)/2)); intros.
apply Rle_trans with (powerRZ radix (e-1)).
apply Rle_powerRZ; auto with real zarith.
assert (exists f:float, Fbounded bo f /\ (FtoRradix f=powerRZ radix (e - 1))%R).
exists (Float 1 (e-1)); split.
split; simpl; auto with zarith float.
apply vNumbMoreThanOne with radix precision; auto with zarith.
unfold FtoRradix, FtoR; simpl; ring.
elim H7; intros f T; elim T; intros; clear H7 T.
rewrite <- H9; unfold FtoRradix.
apply RoundAbsMonotonel with bo precision (Closest bo radix) (f1+f2)%R; auto.
apply ClosestRoundedModeP with precision; auto with zarith.
fold FtoRradix; rewrite H9.
unfold Zminus; rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify(2*1)%R; apply Rle_trans with ((Rabs f1)/2)%R.
unfold Rdiv; apply Rmult_le_compat_r; auto with real.
apply Rle_trans with (Rabs f1 -(Rabs f1)/2)%R;[right; field; auto with real|idtac].
apply Rle_trans with (Rabs f1-Rabs f2)%R.
unfold Rminus; apply Rplus_le_compat_l; auto with real.
rewrite <- (Rabs_Ropp f2).
replace (f1+f2)%R with (f1-(-f2))%R; try ring.
apply Rabs_triang_inv.
elim plusExactExp with bo radix precision f1 f2 g; auto with zarith.
intros s T; elim T; intros g' T'; elim T'; intros R1 T''; clear T T'.
elim T''; intros R2 T; elim T; intros R3 T'; elim T'; intros R4 TT; clear T T' T''.
elim TT; intros R5 T; elim T; intros R6 R7; clear T TT.
replace (FtoRradix g) with (FtoRradix g'); auto with real.
apply Rle_trans with (powerRZ radix (Fexp g')).
apply Rle_powerRZ; auto with real zarith.
apply Zle_trans with (Zmin (Fexp f1) (Fexp f2)); auto with zarith.
rewrite Zmin_le2.
apply Zle_trans with ((e-1)-precision+1)%Z; auto with zarith.
apply FexpGeUnderf; auto.
unfold Zminus; rewrite powerRZ_add; auto with real zarith; simpl.
ring_simplify (2*1)%R; apply Rle_trans with ((Rabs f1)/2)%R; auto with real.
unfold Rdiv; apply Rmult_le_compat_r; auto with real.
apply Fcanonic_Rle_Zle with radix bo precision; auto with zarith real.
unfold FtoRradix;  rewrite <- Fabs_correct; auto.
unfold Fabs, FtoR; simpl.
apply Rle_trans with (1%Z*powerRZ 2 (Fexp g'))%R;
  [simpl; right; ring|apply Rmult_le_compat_r; auto with real zarith].
case (Zle_lt_or_eq 0 (Zabs (Fnum g'))); auto with zarith real; intros.
case (Z_eq_dec 0 (Fnum g')); intros.
absurd (FtoR radix g=0)%R; auto with real.
rewrite <- R3; unfold FtoR; simpl; rewrite <- e0; simpl; ring.
absurd (0 <  Zabs (Fnum g'))%Z; auto with zarith.
apply Zlt_le_trans with (Zabs_nat (Fnum g')); auto with zarith.
assert  (0 < Zabs_nat (Fnum g')); auto with zarith arith.
apply absolu_lt_nz; auto.
rewrite Zabs_absolu; auto with zarith.
Qed.

Theorem AddExpGe1Underf2: forall f1:float ,forall f2:float, forall g:float, forall e:Z,
    Closest bo radix (f1+f2) g -> (Fbounded bo f1) -> (Fbounded bo f2)
      ->  (powerRZ radix e <= Rabs f1)%R
      ->  (-dExp bo <= e-1)%Z
      ->  (FtoRradix g <>0)%R 
      -> (powerRZ radix (e-precision) <= Rabs g)%R.
intros.
case (AddExpGe1Underf (Fnormalize radix bo precision f1) 
       (Fnormalize radix bo precision f2)  g e); auto.
unfold FtoRradix; repeat rewrite FnormalizeCorrect; auto with real.
apply FnormalizeCanonic; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
unfold FtoRradix; rewrite FnormalizeCorrect; auto with real.
intros; absurd (FtoRradix g=0); auto with real.
Qed.



Variables a b c p q t dp dq s d u v:float.

Let delta := (Rabs (d-(b*b-a*c)))%R.

Hypothesis Fa : (Fbounded bo a).
Hypothesis Fb : (Fbounded bo b).
Hypothesis Fc : (Fbounded bo c).
Hypothesis Fdp: (u < v)%R -> (Fbounded bo dp).
Hypothesis Fdq: (u < v)%R -> (Fbounded bo dq).

(** There is no underflow *)

Hypothesis U1: (FtoRradix b=0)%R \/
    (powerRZ radix (-dExp bo+3*precision-1) <= Rabs (b*b))%R.
Hypothesis U2: (a*c=0)%R  \/
  (powerRZ radix (-dExp bo+3*precision-1) <= Rabs (a*c))%R.


Hypothesis Roundp : (EvenClosest bo radix precision (b*b)%R p).
Hypothesis Roundq : (EvenClosest bo radix precision (a*c)%R q).
Hypothesis Roundt : (EvenClosest bo radix precision (p-q)%R t).
Hypothesis Roundu : (EvenClosest bo radix precision (3*Rabs t)%R u).
Hypothesis Roundv : (EvenClosest bo radix precision (p+q)%R v).


Hypothesis FRoundd : (v <= u)%R -> 
   (EvenClosest bo radix precision (p-q)%R d).

Hypothesis dpEq   : (FtoRradix dp=b*b-p)%R.
Hypothesis dqEq   : (FtoRradix dq=a*c-q)%R.
Hypothesis SRounds : (u < v)%R -> (EvenClosest bo radix precision (dp-dq)%R s).
Hypothesis SRoundd : (u < v)%R -> (EvenClosest bo radix precision (t+s)%R d).

Theorem pGeUnderf: (FtoRradix b <> 0)%R ->
   (powerRZ radix (-dExp bo+3*precision-1) <= Rabs (p))%R.
case U1; intros.
absurd (FtoRradix b=0); auto with real.
assert (exists f:float, Fbounded bo f /\ 
  (powerRZ radix (- dExp bo + 3 * precision - 1)= f)%R).
exists (Float 1  (- dExp bo + 3 * precision - 1)).
split;[split|unfold FtoRradix, FtoR; simpl; ring].
simpl; apply vNumbMoreThanOne with radix precision; auto with zarith.
apply Zle_trans with (- dExp bo + 3 * precision - 1)%Z; auto with zarith.
elim H1; intros f T; elim T; intros; clear H1 T.
rewrite H3; unfold FtoRradix.
apply RoundAbsMonotonel with bo precision (EvenClosest bo radix precision)
    (b*b)%R; auto with real zarith float.
fold FtoRradix; rewrite <- H3; auto.
Qed.


Theorem qGeUnderf: (a*c <> 0)%R ->
(powerRZ radix (-dExp bo+3*precision-1) <= Rabs (q))%R.
case U2; intros.
absurd (a*c=0)%R; auto with real.
assert (exists f:float, Fbounded bo f /\ 
  (powerRZ radix (- dExp bo + 3 * precision - 1)= f)%R).
exists (Float 1  (- dExp bo + 3 * precision - 1)).
split;[split|unfold FtoRradix, FtoR; simpl; ring].
simpl; apply vNumbMoreThanOne with radix precision; auto with zarith.
apply Zle_trans with (- dExp bo + 3 * precision - 1)%Z; auto with zarith.
elim H1; intros f T; elim T; intros; clear H1 T.
rewrite H3; unfold FtoRradix.
apply RoundAbsMonotonel with bo precision (EvenClosest bo radix precision)
    (a*c)%R; auto with real zarith float.
fold FtoRradix; rewrite <- H3; auto.
Qed.


Theorem cases: (FtoRradix b=0)%R \/ (a*c=0)%R 
   \/ (FtoRradix d=0)%R \/  (FtoRradix v=0)%R \/ (FtoRradix t=0)%R \/
    ((powerRZ radix (-dExp bo+2*precision-1) <= Rabs (b*b))%R
     /\ (powerRZ radix (-dExp bo+2*precision-1) <= Rabs (a*c))%R
     /\ (powerRZ radix (-dExp bo+precision) <= Rabs d)%R
     /\ (powerRZ radix (-dExp bo+precision-1) <= Rabs u)%R
     /\ (powerRZ radix (-dExp bo+precision-1) <= Rabs v)%R
     /\ (powerRZ radix (-dExp bo+precision) <= Rabs t)%R).
case U1; auto; intros.
case U2; auto; intros.
case (Req_dec b 0); auto with real; intros; right.
case (Req_dec (a*c) 0); auto with real; intros; right.
assert (True); auto.
case (Req_dec d 0); auto with real; intros; right.
case (Req_dec v 0); auto with real; intros; right.
case (Req_dec t 0); auto with real; intros; right.
assert (powerRZ radix (-dExp bo+3*precision-1) <= Rabs (p))%R.
apply pGeUnderf; auto with real.
assert (powerRZ radix (-dExp bo+3*precision-1) <= Rabs (q))%R.
apply qGeUnderf; auto with real.
assert (powerRZ radix (-dExp bo+2*precision) <= Rabs v)%R.
replace (-dExp bo+2*precision)%Z with  
  ((-dExp bo+3*precision-1)-precision+1)%Z; auto with zarith.
apply AddExpGeUnderf2 with p q; auto.
elim Roundv; auto.
elim Roundp; intros A1 A2; elim A1; auto.
elim Roundq; intros A1 A2; elim A1; auto.
assert (powerRZ radix (-dExp bo+2*precision) <= Rabs t)%R.
replace (-dExp bo+2*precision)%Z with  
  ((-dExp bo+3*precision-1)-precision+1)%Z; auto with zarith.
apply AddExpGeUnderf2 with p (Fopp q); auto.
unfold FtoRradix; rewrite Fopp_correct; elim Roundt; auto with real.
elim Roundp; intros A1 A2; elim A1; auto.
apply oppBounded; elim Roundq; intros A1 A2; elim A1; auto.
unfold FtoRradix; rewrite Fopp_correct;rewrite Rabs_Ropp; auto with real.
assert (powerRZ radix (-dExp bo+precision+1) <= Rabs u)%R.
replace (-dExp bo+precision+1)%Z with  
  ((-dExp bo+2*precision)-precision+1)%Z; auto with zarith.
apply AddExpGeUnderf2 with (Fabs t) (Fabs (Float (Fnum t) (Fexp t+1))); auto.
replace (Fabs t + Fabs (Float (Fnum t) (Fexp t + 1)))%R with (3*Rabs t)%R;
  [elim Roundu; auto|idtac].
unfold FtoRradix; rewrite <- Fabs_correct; auto; unfold FtoR, Fabs; simpl.
rewrite powerRZ_add; auto with real zarith; simpl; ring.
apply absFBounded; elim Roundt;  intros A1 A2; elim A1; auto.
elim Roundt;  intros A1 A2; elim A1; intros A4 A3; elim A4; intros.
split; unfold Fabs; simpl; auto with zarith.
rewrite Zabs_eq; auto with zarith.
unfold FtoRradix; rewrite Fabs_correct; auto.
rewrite Rabs_right; auto with real.
apply Rle_trans with (1:=H10).
apply Rle_trans with (1*Rabs t)%R; auto with real.
apply Rle_trans with (2*Rabs t)%R; auto with real.
unfold FtoRradix; rewrite Fabs_correct; auto.
rewrite Rabs_right with  (Rabs (FtoR radix (Float (Fnum t) (Fexp t + 1)))); 
   auto with real.
repeat rewrite <- Fabs_correct; auto; unfold FtoR, Fabs; simpl.
rewrite powerRZ_add; auto with real zarith; simpl; right; ring.
assert (0 < u)%R; auto with real.
apply Rlt_le_trans with (Rabs t); auto with real.
assert (Rabs t <> 0)%R; auto with real.
apply Rabs_no_R0; auto with real.
assert (A:(0 <= Rabs t)%R); auto with real; case A; auto with real.
intros; absurd (Rabs t=0)%R; auto with real.
unfold FtoRradix; rewrite <- Fabs_correct; auto.
apply RleBoundRoundl with bo precision (EvenClosest bo radix precision)
   (3 * Rabs t)%R; auto with zarith float.
apply absFBounded; elim Roundt;  intros A1 A2; elim A1; auto.
apply Rle_trans with (1*Rabs t)%R; auto with real.
rewrite Fabs_correct; auto; right; unfold FtoRradix; ring.
apply Rmult_le_compat_r; auto with real.
apply Rle_trans with 2%R; auto with real.
split.
apply Rle_trans with (2:=H); auto with real zarith.
split.
apply Rle_trans with (2:=H0); auto with real zarith.
split.
2: split.
2: apply Rle_trans with (2:=H11); auto with real zarith.
2:split.
2:apply Rle_trans with (2:=H9); auto with real zarith.
2:apply Rle_trans with (2:=H10); auto with real zarith.
case (Rle_or_lt v u); intros.
assert (powerRZ radix (-dExp bo+2*precision) <= Rabs d)%R.
replace (-dExp bo+2*precision)%Z with  
  ((-dExp bo+3*precision-1)-precision+1)%Z; auto with zarith.
apply AddExpGeUnderf2 with p (Fopp q); auto.
unfold FtoRradix; rewrite Fopp_correct; elim FRoundd; auto with real.
elim Roundp; intros A1 A2; elim A1; auto.
apply oppBounded; elim Roundq; intros A1 A2; elim A1; auto.
unfold FtoRradix; rewrite Fopp_correct;rewrite Rabs_Ropp; auto with real.
apply Rle_trans with (2:=H13); auto with real zarith.
replace (-dExp bo+precision)%Z with  
  ((-dExp bo+2*precision)-precision)%Z; auto with zarith.
apply AddExpGe1Underf2 with t s; auto with zarith.
elim SRoundd; auto with real.
elim Roundt; intros A1 A2; elim A1; auto.
elim SRounds; auto; intros A1 A2; elim A1; auto.
Qed.




Theorem discri16: (FtoRradix d=0)%R \/ (delta <= 2*(Fulp bo radix precision d))%R.
assert (Fq:(Fbounded bo q)).
elim Roundq; intros A1 A2; elim A1; auto with zarith float.
assert (Fp:(Fbounded bo p)).
elim Roundp; intros A1 A2; elim A1; auto with zarith float.
assert (Fd:(Fbounded bo d)).
case (Rle_or_lt v u); intros.
elim FRoundd; auto; intros L; elim L; 
   intros A1 A2; elim A1; auto with zarith float.
elim SRoundd; auto; intros L; elim L; 
   intros A1 A2; elim A1; auto with zarith float.
generalize cases; intros C.
case C; clear C; intros C.
assert (FtoRradix p=0)%R; auto with real.
assert (0 <= p)%R.
unfold FtoRradix; apply RleRoundedR0 with bo precision
    (EvenClosest bo radix precision) (b*b)%R; auto with real float zarith.
rewrite C; right; ring.
assert (p <= 0)%R; auto with real.
unfold FtoRradix; apply RleRoundedLessR0 with bo precision
    (EvenClosest bo radix precision) (b*b)%R; auto with real float zarith.
rewrite C; right; ring.
assert (FtoRradix d=(Fopp q))%R.
apply sym_eq; unfold FtoRradix; apply RoundedModeProjectorIdemEq 
  with bo precision (EvenClosest bo radix precision); auto with float zarith.
replace (FtoR radix (Fopp q)) with (p-q)%R; [apply FRoundd|
   rewrite Fopp_correct; fold FtoRradix; rewrite H; ring].
unfold FtoRradix; apply EvenClosestMonotone2 with bo precision
   (p+q)%R (3*Rabs t)%R; auto.
replace (FtoRradix t) with (FtoRradix (Fopp q)).
unfold FtoRradix; rewrite Fopp_correct;auto; fold FtoRradix.
rewrite H; ring_simplify (0+q)%R.
rewrite Rabs_Ropp; apply Rle_trans with (1:=(RRle_abs q)).
apply Rle_trans with (1*(Rabs q))%R; auto with real.
apply Rmult_le_compat_r; auto with real.
apply Rle_trans with 2%R; auto with real.
unfold FtoRradix; apply RoundedModeProjectorIdemEq 
  with bo precision (EvenClosest bo radix precision); auto with float zarith.
replace (FtoR radix (Fopp q)) with (p-q)%R; [auto|
   rewrite Fopp_correct; fold FtoRradix; rewrite H; ring].
right; unfold delta; rewrite H0.
unfold FtoRradix; rewrite Fopp_correct; fold FtoRradix.
replace (-q-(b*b-a*c))%R with ((a*c-q))%R;[idtac|rewrite C; ring].
apply Rle_trans with (/2*(Fulp bo radix precision q))%R.
apply Rmult_le_reg_l with (2%nat)%R; auto with real zarith.
apply Rle_trans with (Fulp bo radix precision q);[idtac|simpl; right; field; auto with real].
unfold FtoRradix; apply ClosestUlp; auto.
elim Roundq; auto.
apply Rle_trans with (2 * Fulp bo radix precision q)%R;
  [apply Rmult_le_compat_r; auto with real|idtac].
unfold Fulp; auto with real zarith.
apply Rle_trans with 1%R; auto with real.
apply Rle_trans with (/1)%R; auto with real.
apply Rmult_le_compat_l; auto with real; right.
apply trans_eq with (Fulp bo radix precision (Fopp q)).
unfold Fulp; rewrite Fnormalize_Fopp; auto with real zarith.
apply FulpComp; auto with float zarith.
case C; clear C; intros C.
assert (FtoRradix q=0)%R; auto with real.
assert (0 <= q)%R.
unfold FtoRradix; apply RleRoundedR0 with bo precision
    (EvenClosest bo radix precision) (a*c)%R; auto with real float zarith.
assert (q <= 0)%R; auto with real.
unfold FtoRradix; apply RleRoundedLessR0 with bo precision
    (EvenClosest bo radix precision) (a*c)%R; auto with real float zarith.
assert (FtoRradix d=p)%R.
apply sym_eq; unfold FtoRradix; apply RoundedModeProjectorIdemEq 
  with bo precision (EvenClosest bo radix precision); auto with float zarith.
replace (FtoR radix p) with (p-q)%R; [apply FRoundd|
  fold FtoRradix; rewrite H; ring].
unfold FtoRradix; apply EvenClosestMonotone2 with bo precision
   (p+q)%R (3*Rabs t)%R; auto.
replace (FtoRradix t) with (FtoRradix p).
rewrite H; ring_simplify (p+0)%R; apply Rle_trans with (1:=(RRle_abs p)).
apply Rle_trans with (1*(Rabs p))%R; auto with real.
apply Rmult_le_compat_r; auto with real.
apply Rle_trans with 2%R; auto with real.
unfold FtoRradix; apply RoundedModeProjectorIdemEq 
  with bo precision (EvenClosest bo radix precision); auto with float zarith.
replace (FtoR radix p) with (p-q)%R; [auto|
   fold FtoRradix; rewrite H; ring].
right; unfold delta; rewrite H0.
replace (p-(b*b-a*c))%R with ((-(b*b-p)))%R;[idtac|rewrite C; ring].
apply Rle_trans with (/2*(Fulp bo radix precision p))%R.
apply Rmult_le_reg_l with (2%nat)%R; auto with real zarith.
apply Rle_trans with (Fulp bo radix precision p);[idtac|simpl; right; field; auto with real].
rewrite Rabs_Ropp; unfold FtoRradix; apply ClosestUlp; auto.
elim Roundp; auto.
rewrite FulpComp with bo radix precision d p; auto with float zarith.
apply Rmult_le_compat_r; auto with real.
unfold Fulp; auto with real zarith.
apply Rle_trans with (/1)%R; auto with real.
apply Rle_trans with 1%R; auto with real.
case (Req_dec v 0)%R.
clear C; intros C.
assert (v <= u)%R.
rewrite C; unfold FtoRradix; apply RleRoundedR0 with bo precision
    (EvenClosest bo radix precision) (3*Rabs t)%R; auto with real float zarith.
apply Rle_trans with (0*0)%R; auto with real; apply Rmult_le_compat; auto with real.
apply Rle_trans with 2%R; auto with real.
assert (FtoRradix q=-p)%R.
assert (FtoRradix v=p+q)%R.
unfold FtoRradix; apply plusExactR0 with bo precision; auto with real.
elim Roundv; auto.
apply Rplus_eq_reg_l with p.
rewrite <- H0; rewrite C; ring.
assert (FtoRradix d=2*p)%R.
assert (exists f:float, Fbounded bo f /\ (FtoRradix f=2*p)%R).
exists (Float (Fnum p) (Fexp p+1)); split.
elim Fp; intros; split; simpl; auto with zarith.
unfold FtoRradix, FtoR; simpl; rewrite powerRZ_add; auto with real zarith;
   simpl; ring.
elim H1; intros f T; elim T; intros; clear T H1.
rewrite <- H3; unfold FtoRradix; apply sym_eq.
apply RoundedModeProjectorIdemEq 
  with bo precision (EvenClosest bo radix precision); auto with float zarith.
replace (FtoR radix f) with (p-q)%R; auto.
fold FtoRradix; rewrite H3; rewrite H0; ring.
right; unfold delta.
replace (d - (b * b - a * c))%R with (-(b*b-p)+(a*c-q))%R;
  [idtac|rewrite H1; rewrite H0; ring].
apply Rle_trans with (Rabs (- (b * b - p)) + Rabs ((a * c - q)))%R;
  [apply Rabs_triang|idtac].
apply Rle_trans with (/2*(Fulp bo radix precision p)
  +/2*(Fulp bo radix precision q))%R.
apply Rplus_le_compat; apply Rmult_le_reg_l with (2%nat)%R; auto with real zarith.
apply Rle_trans with (Fulp bo radix precision p);
  [idtac|simpl; right; field; auto with real].
rewrite Rabs_Ropp; unfold FtoRradix; apply ClosestUlp; auto.
elim Roundp; auto.
apply Rle_trans with (Fulp bo radix precision q);
  [idtac|simpl; right; field; auto with real].
unfold FtoRradix; apply ClosestUlp; auto.
elim Roundq; auto.
replace (Fulp bo radix precision q) with (Fulp bo radix precision p).
apply Rle_trans with (Fulp bo radix precision p);
 [right; field; auto with real|idtac].
apply Rle_trans with (1*(Fulp bo radix precision d))%R;
 [idtac|apply Rmult_le_compat_r; unfold Fulp; auto with real zarith].
apply Rle_trans with (Fulp bo radix precision d); auto with real.
assert (0 <= p)%R.
apply P_positive with bo precision b b; auto.
fold FtoRradix; apply Rle_trans with (Rsqr b); auto with real.
apply LeFulpPos; auto with real zarith.
fold FtoRradix; rewrite H1; apply Rle_trans with (1*p)%R; auto with real.
apply trans_eq with (Fulp bo radix precision (Fopp p)).
unfold Fulp; rewrite Fnormalize_Fopp; auto with real zarith.
apply FulpComp; auto with float zarith.
rewrite Fopp_correct; auto with real zarith.
intros C'.
case (Req_dec t 0).
clear C; intros C.
assert (FtoRradix p=q)%R.
assert (FtoRradix t=p+ Fopp q)%R.
unfold FtoRradix; apply plusExactR0 with bo precision; auto with real zarith float.
elim Roundt; intros; rewrite Fopp_correct; auto with real.
apply Rplus_eq_reg_l with (Fopp q); rewrite Rplus_comm.
rewrite <- H; rewrite C; unfold FtoRradix; rewrite Fopp_correct; auto; ring.
assert (FtoRradix v=2*p)%R.
assert (exists f:float, Fbounded bo f /\ (FtoRradix f=2*p)%R).
exists (Float (Fnum p) (Fexp p+1)); split.
elim Fp; intros; split; simpl; auto with zarith.
unfold FtoRradix, FtoR; simpl; rewrite powerRZ_add; auto with real zarith;
   simpl; ring.
elim H0; intros f T; elim T; intros; clear T H0.
rewrite <- H2; unfold FtoRradix; apply sym_eq.
apply RoundedModeProjectorIdemEq 
  with bo precision (EvenClosest bo radix precision); auto with float zarith.
replace (FtoR radix f) with (p+q)%R; auto.
fold FtoRradix; rewrite H2; rewrite H; ring.
assert (FtoRradix u=0)%R. 
assert (0 <= u)%R.
unfold FtoRradix; apply RleRoundedR0 with bo precision
    (EvenClosest bo radix precision) (3*Rabs t)%R; auto with real float zarith.
rewrite C; rewrite Rabs_R0; right; ring.
assert (u <= 0)%R; auto with real.
unfold FtoRradix; apply RleRoundedLessR0 with bo precision
    (EvenClosest bo radix precision) (3*Rabs t)%R; auto with real float zarith.
rewrite C; rewrite Rabs_R0; right; ring.
assert (u < v)%R.
rewrite H1; assert (0 <= v)%R; auto with real.
rewrite H0; apply Rle_trans with (0*0)%R; auto with real.
apply Rmult_le_compat; auto with real.
apply P_positive with bo precision b b; auto.
apply Rle_trans with (Rsqr (FtoR radix b)); auto with real.
case H2; auto with real.
intros T; absurd (FtoRradix v=0)%R; auto with real.
assert (FtoRradix d=s)%R.
unfold FtoRradix; apply sym_eq.
apply RoundedModeProjectorIdemEq 
  with bo precision (EvenClosest bo radix precision); auto with float zarith.
elim SRounds; auto; intros A1 A2; elim A1; auto.
replace (FtoR radix s) with (t+s)%R; auto.
fold FtoRradix; rewrite C; ring.
right; unfold delta.
replace (d - (b * b - a * c))%R with (-((dp-dq)-s))%R;
  [idtac|rewrite dpEq; auto; rewrite dqEq; auto; rewrite H3; rewrite H; ring].
apply Rle_trans with (/2*(Fulp bo radix precision s))%R.
apply Rmult_le_reg_l with (2%nat)%R; auto with real zarith.
apply Rle_trans with (Fulp bo radix precision s);
  [idtac|simpl; right; field; auto with real].
rewrite Rabs_Ropp; unfold FtoRradix; apply ClosestUlp; auto.
elim SRounds; auto.
rewrite FulpComp with bo radix precision d s; auto with zarith real.
2: elim SRounds; auto; intros A1 A2; elim A1; auto.
apply Rmult_le_compat_r.
unfold Fulp; auto with real zarith.
apply Rle_trans with (/1)%R; auto with real.
apply Rle_trans with 1%R; auto with real.
intros C''.
case (Rle_or_lt v u); intros.
case C; clear C; intros C; auto with real.
case C; clear C; intros C; auto with real.
absurd (FtoRradix v=0)%R; auto with real.
case C; clear C; intros C; auto with real.
absurd (FtoRradix t=0)%R; auto with real.
elim C;  intros Y1 C1; elim C1; intros Y2 C2; elim C2; intros Y3 C3; clear C C1 C2.
elim C3; intros Y4 C4; elim C4; intros Y5 Y6; clear C3 C4.
right; unfold delta;apply discri15 with p q t dp dq s  u v; auto with real zarith float.
case C; clear C; intros C; auto with real.
case C; clear C; intros C; auto with real.
absurd (FtoRradix v=0)%R; auto with real.
case C; clear C; intros C; auto with real.
absurd (FtoRradix t=0)%R; auto with real.
elim C;  intros Y1 C1; elim C1; intros Y2 C2; elim C2; intros Y3 C3; clear C C1 C2.
elim C3; intros Y4 C4; elim C4; intros Y5 Y6; clear C3 C4.
right; unfold delta;apply discri15 with p q t dp dq s  u v; auto with real zarith float.
Qed.
End Discriminant7.
