Section Fcore_ulp.
Variable beta : radix.
Notation bpow e := (bpow beta e).
Variable fexp : Z -> Z.
(** Definition and basic properties about the minimal exponent, when it exists *)
(** [negligible_exp] is either none (as in FLX) or Some n such that n <= fexp n. *)
Definition negligible_exp: option Z :=
match (LPO_Z _ (fun z => Z_le_dec_aux z (fexp z))) with
| inleft N => Some (proj1_sig N)
| inright _ => None
end.
Inductive negligible_exp_prop: option Z -> Prop :=
| negligible_None: (forall n, (fexp n < n)%Z) -> negligible_exp_prop None
| negligible_Some: forall n, (n <= fexp n)%Z -> negligible_exp_prop (Some n).
Context { valid_exp : Valid_exp fexp }.
(** Definition and basic properties about the ulp *)
(** Now includes a nice ulp(0): ulp(0) is now 0 when there is no minimal exponent, such as in FLX, and beta^(fexp n) when there is a n such that n <= fexp n. For instance, the value of ulp(O) is then beta^emin in FIX and FLT. The main lemma to use is ulp_neq_0 that is equivalent to the previous "unfold ulp" provided the value is not zero. *)
Definition ulp x := match Req_bool x 0 with
| true   => match negligible_exp with
| Some n => bpow (fexp n)
| None => 0%R
end
| false  => bpow (cexp beta fexp x)
end.
Notation F := (generic_format beta fexp).
(** The three following properties are equivalent: [Exp_not_FTZ] ;  forall x, F (ulp x) ; forall x, ulp 0 <= ulp x *)
Proof with auto with typeclass_instances.
intros Hm x y Hx Hxy.
destruct Hx as [Hx|Hx].
rewrite ulp_neq_0.
rewrite ulp_neq_0.
apply bpow_le.
apply Hm.
now apply mag_le.
apply Rgt_not_eq, Rlt_gt.
now apply Rlt_le_trans with (1:=Hx).
now apply Rgt_not_eq.
rewrite <- Hx.
apply ulp_ge_ulp_0.
apply monotone_exp_not_FTZ...
Qed.
(** Definition and properties of pred and succ *)
Definition pred_pos x :=
if Req_bool x (bpow (mag beta x - 1)) then
(x - bpow (fexp (mag beta x - 1)))%R
else
(x - ulp x)%R.
Definition succ x :=
if (Rle_bool 0 x) then
(x+ulp x)%R
else
(- pred_pos (-x))%R.
Definition pred x := (- succ (-x))%R.
(** pred and succ are in the format *)

Lemma pred_pos_plus_ulp_aux1 :
forall x, (0 < x)%R -> F x ->
x <> bpow (mag beta x - 1) ->
((x - ulp x) + ulp (x-ulp x) = x)%R.