Proof with auto with typeclass_instances.
intros Hm choice x.
case (Req_dec (round beta fexp (Znearest choice) x) 0); intros Hfx.
(* *)
case (Req_dec x 0); intros Hx.
apply Rle_trans with (1:=error_le_half_ulp _ _).
rewrite Hx, round_0...
right; ring.
generalize (error_le_half_ulp choice x).
rewrite Hfx.
unfold Rminus; rewrite Rplus_0_l, Rabs_Ropp.
intros N.
unfold ulp; rewrite Req_bool_true; trivial.
case negligible_exp_spec'.
intros (H1,H2).
contradict Hfx.
apply round_neq_0_negligible_exp...
intros (n,(H1,Hn)); rewrite H1.
apply Rle_trans with (1:=N).
right; apply f_equal.
rewrite ulp_neq_0; trivial.
apply f_equal.
unfold canonic_exp.
apply valid_exp; trivial.
assert (ln_beta beta x -1 < fexp n)%Z;[idtac|omega].
apply lt_bpow with beta.
destruct (ln_beta beta x) as (e,He).
simpl.
apply Rle_lt_trans with (Rabs x).
now apply He.
apply Rle_lt_trans with (Rabs (round beta fexp (Znearest choice) x - x)).
right; rewrite Hfx; unfold Rminus; rewrite Rplus_0_l.
apply sym_eq, Rabs_Ropp.
apply Rlt_le_trans with (ulp 0).
rewrite <- Hfx.
apply error_lt_ulp_round...
unfold ulp; rewrite Req_bool_true, H1; trivial.
now right.
(* *)
case (round_DN_or_UP beta fexp (Znearest choice) x); intros Hx.
(* . *)
case (Rle_or_lt 0 (round beta fexp Zfloor x)).
intros H; destruct H.
rewrite Hx at 2.
rewrite ulp_DN; trivial.
apply error_le_half_ulp.
rewrite Hx in Hfx; contradict Hfx; auto with real.
intros H.
apply Rle_trans with (1:=error_le_half_ulp _ _).
apply Rmult_le_compat_l.
apply Rlt_le, pos_half_prf.
apply ulp_le.
rewrite Hx; rewrite (Rabs_left1 x), Rabs_left; try assumption.
apply Ropp_le_contravar.
apply (round_DN_pt beta fexp x).
case (Rle_or_lt x 0); trivial.
intros H1; contradict H.
apply Rle_not_lt.
apply round_ge_generic...
apply generic_format_0.
now left.
(* . *)
case (Rle_or_lt 0 (round beta fexp Zceil x)).
intros H; destruct H.
apply Rle_trans with (1:=error_le_half_ulp _ _).
apply Rmult_le_compat_l.
apply Rlt_le, pos_half_prf.
apply ulp_le_pos; trivial.
case (Rle_or_lt 0 x); trivial.
intros H1; contradict H.
apply Rle_not_lt.
apply round_le_generic...
apply generic_format_0.
now left.
rewrite Hx; apply (round_UP_pt beta fexp x).
rewrite Hx in Hfx; contradict Hfx; auto with real.
intros H.
rewrite Hx at 2; rewrite <- (ulp_opp (round beta fexp Zceil x)).
rewrite <- round_DN_opp.
rewrite ulp_DN; trivial.
pattern x at 1 2; rewrite <- Ropp_involutive.
rewrite round_N_opp.
unfold Rminus.
rewrite <- Ropp_plus_distr, Rabs_Ropp.
apply error_le_half_ulp.
rewrite round_DN_opp; apply Ropp_0_gt_lt_contravar; apply Rlt_gt; assumption.
Qed.

(* Specifications: *)
Theorem pred_le :
forall x y, F x -> F y -> (x <= y)%R ->
(pred x <= pred y)%R.
Theorem succ_le: forall x y,
F x -> F y -> (x <= y)%R -> (succ x <= succ y)%R.
Theorem pred_le_inv: forall x y, F x -> F y
-> (pred x <= pred y)%R -> (x <= y)%R.
Theorem succ_le_inv: forall x y, F x -> F y
-> (succ x <= succ y)%R -> (x <= y)%R.
Theorem pred_lt :
forall x y, F x -> F y -> (x < y)%R ->
(pred x < pred y)%R.
Theorem succ_lt :
forall x y, F x -> F y -> (x < y)%R ->
(succ x < succ y)%R.
(* was lt_UP_le_DN *)
Theorem le_round_DN_lt_UP :
forall x y, F y ->
(y < round beta fexp Zceil x -> y <= round beta fexp Zfloor x)%R.
Theorem pred_le: forall x y,
F x -> F y -> (x <= y)%R -> (pred x <= pred y)%R.
Theorem succ_le: forall x y,
F x -> F y -> (x <= y)%R -> (succ x <= succ y)%R.
Theorem pred_le_inv: forall x y, F x -> F y
-> (pred x <= pred y)%R -> (x <= y)%R.
Theorem succ_le_inv: forall x y, F x -> F y
-> (succ x <= succ y)%R -> (x <= y)%R.
(* was lt_UP_le_DN *)
Theorem le_round_DN_lt_UP :
forall x y, F y ->
(y < round beta fexp Zceil x -> y <= round beta fexp Zfloor x)%R.