Proof with auto with typeclass_instances.
intros Hm.
(* wlog *)
cut (forall rnd : R -> Z, Valid_rnd rnd -> forall x : R, (0 < x)%R  ->
(Rabs (round beta fexp rnd x - x) < ulp (round beta fexp rnd x))%R).
intros M rnd Hrnd x Zx.
case (Rle_or_lt 0 x).
intros H; destruct H.
now apply M.
contradict H; now apply sym_not_eq.
intros H.
rewrite <- (Ropp_involutive x).
rewrite round_opp, ulp_opp.
replace (- round beta fexp (Zrnd_opp rnd) (- x) - - - x)%R with
(-(round beta fexp (Zrnd_opp rnd) (- x) - (-x)))%R by ring.
rewrite Rabs_Ropp.
apply M.
now apply valid_rnd_opp.
now apply Ropp_0_gt_lt_contravar.
(* 0 < x *)
intros rnd Hrnd x Hx.
case (Rle_lt_or_eq_dec 0 (round beta fexp Zfloor x)).
apply round_ge_generic...
apply generic_format_0.
now left.
(* . 0 < round Zfloor x *)
intros Hx2.
apply Rlt_le_trans with (ulp x).
apply error_lt_ulp...
now apply Rgt_not_eq.
rewrite <- ulp_DN; trivial.
apply ulp_le_pos.
now left.
case (round_DN_or_UP beta fexp rnd x); intros V; rewrite V.
apply Rle_refl.
apply Rle_trans with x.
apply round_DN_pt...
apply round_UP_pt...
(* . 0 = round Zfloor x *)
intros Hx2.
case (round_DN_or_UP beta fexp rnd x); intros V; rewrite V; clear V.
(* .. round down -- difficult case *)
rewrite <- Hx2.
unfold Rminus; rewrite Rplus_0_l, Rabs_Ropp.
unfold ulp; rewrite Req_bool_true; trivial.
case negligible_exp_spec.
(* without minimal exponent *)
intros K; contradict Hx2.
apply Rlt_not_eq.
apply F2R_gt_0_compat; simpl.
apply Zlt_le_trans with 1%Z.
apply Pos2Z.is_pos.
apply Zfloor_lub.
simpl; unfold scaled_mantissa, canonic_exp.
destruct (ln_beta beta x) as (e,He); simpl.
apply Rle_trans with (bpow (e-1) * bpow (- fexp e))%R.
rewrite <- bpow_plus.
replace 1%R with (bpow 0) by reflexivity.
apply bpow_le.
specialize (K e); omega.
apply Rmult_le_compat_r.
apply bpow_ge_0.
rewrite <- (Rabs_pos_eq x).
now apply He, Rgt_not_eq.
now left.
(* with a minimal exponent *)
intros n Hn.
rewrite Rabs_pos_eq;[idtac|now left].
case (Rle_or_lt (bpow (fexp n)) x); trivial.
intros K; contradict Hx2.
apply Rlt_not_eq.
apply Rlt_le_trans with (bpow (fexp n)).
apply bpow_gt_0.
apply round_ge_generic...
apply generic_format_bpow.
now apply valid_exp.
(* .. round up *)
apply Rlt_le_trans with (ulp x).
apply error_lt_ulp...
now apply Rgt_not_eq.
apply ulp_le_pos.
now left.
apply round_UP_pt...
Qed.

(** allows both x and rnd x to be 0 *)
(* was ulp_half_error_f *)
Theorem error_le_half_ulp_round :
forall { Hm : Monotone_exp fexp },
forall choice x,
(Rabs (round beta fexp (Znearest choice) x - x) <= /2 * ulp (round beta fexp (Znearest choice) x))%R.