intros x p H.
cut (Fcanonic radix b (Fnormalize radix b precision p));
[ intros tmp; Casec tmp; intros Fs | idtac ].
3: apply FnormalizeCanonic; auto with arith.
3: apply
RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := x);
auto.
3: apply ClosestRoundedModeP with (precision := precision); auto.
cut (~ is_Fzero (Fnormalize radix b precision p));
[ unfold is_Fzero in |- *; intros tmp
| apply FnormalNotZero with radix b; auto ].
cut (FtoRradix p <> 0%R); [ intros H1; clear tmp | unfold FtoRradix in |- * ].
2: rewrite <- FnormalizeCorrect with radix b precision p; auto;
unfold FtoR in |- *; simpl in |- *.
2: apply Rmult_integral_contrapositive; split; auto with real zarith.
exists ((x - p) / p)%R; exists 0%R.
split; [ case (Req_dec x 0); intros H2 | idtac ].
repeat rewrite H2; unfold Rdiv in |- *.
ring_simplify.
rewrite <- FzeroisZero with radix b; unfold FtoRradix in |- *.
cut (ProjectorP b radix (Closest b radix));
[ unfold ProjectorP in |- *; intros H3
| apply RoundedProjector; auto with float ].
apply H3; auto with float zarith.
replace (FtoR radix (Fzero (- dExp b))) with x; auto with real.
rewrite H2; unfold Fzero, FtoR in |- *; simpl in |- *; ring.
apply ClosestRoundedModeP with precision; auto with zarith.
apply sym_eq; apply trans_eq with (x / (1 + (x - p) / p))%R; [ idtac | ring ].
replace (1 + (x - FtoRradix p) / FtoRradix p)%R with (x / p)%R;
unfold Rdiv in |- *.
rewrite Rinv_mult_distr; auto with real; rewrite Rinv_involutive; auto;
rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real.
ring_simplify; rewrite Rinv_l; auto with real; ring.
split.
apply Rmult_le_reg_l with (Rabs p); [ apply Rabs_pos_lt; auto | idtac ].
apply Rle_trans with (Rabs (x - FtoRradix p));
[ right | apply ClosestErrorBoundNormal; auto ].
unfold Rdiv in |- *; rewrite Rabs_mult; rewrite Rabs_Rinv; auto.
rewrite Rmult_comm; rewrite Rmult_assoc; rewrite Rinv_l; auto with real.
apply Rabs_no_R0; exact H1.
split; [ rewrite Rabs_R0; apply Rmult_le_pos; auto with real zarith | idtac ].
split; [ ring | idtac ].
split; [ auto with real | intros H2 ].
absurd
(Fnormal radix b (Fnormalize radix b precision p) /\
Fsubnormal radix b (Fnormalize radix b precision p)).
apply NormalNotSubNormal; auto.
split; auto.
exists 0%R; exists (p - x)%R.
split; [ unfold Rdiv in |- *; ring_simplify (1 + 0)%R; rewrite Rinv_1; ring | idtac ].
split; [ rewrite Rabs_R0; apply Rmult_le_pos; auto with real zarith | idtac ].
split.
apply Rle_trans with (/ 2%nat * Fulp b radix precision p)%R.
rewrite <- Rabs_Ropp;
replace (- (FtoRradix p - x))%R with (x - FtoRradix p)%R;
[ idtac | ring ].
replace (Rabs (x - FtoRradix p)) with
(/ 2%nat * (2%nat * Rabs (x - FtoRradix p)))%R.
apply Rmult_le_compat_l; auto with real; apply ClosestUlp; auto.
rewrite <- Rmult_assoc; rewrite Rinv_l; simpl in |- *; auto with real.
elim Fs; intros H1 H2; elim H2; intros; clear H2.
unfold Fulp in |- *; rewrite H0; auto with real.
split; [ ring | idtac ].
split; [ intros H2 | auto with real ].
absurd
(Fnormal radix b (Fnormalize radix b precision p) /\
Fsubnormal radix b (Fnormalize radix b precision p)).
apply NormalNotSubNormal; auto.
split; auto.
Qed.

(* Specifications: *)
Theorem FpredUlpPos :
forall x : float,
Fcanonic radix b x ->
(0 < x)%R ->
(FPred b radix precision x +
Fulp b radix precision (FPred b radix precision x))%R = x.