Section Extra_ops.
(** [prec] is the number of bits of the mantissa including the implicit one. [emax] is the exponent of the infinities. Typically p=24 and emax = 128 in single precision. *)
Variable prec emax : Z.
Context (prec_gt_0_ : Prec_gt_0 prec).
Let emin := (3 - emax - prec)%Z.
Let fexp := FLT_exp emin prec.
Hypothesis Hmax : (prec < emax)%Z.
Let binary_float := binary_float prec emax.
(** Remarks on [is_finite] *)
Remark is_finite_not_is_nan:
forall (f: binary_float), is_finite _ _ f = true -> is_nan _ _ f = false.
Remark is_finite_strict_finite:
forall (f: binary_float), is_finite_strict _ _ f = true -> is_finite _ _ f = true.
(** Digression on FP numbers that cannot be [-0.0]. *)
Definition is_finite_pos0 (f: binary_float) : bool :=
match f with
| B754_zero _ _ s => negb s
| B754_infinity _ _ _ => false
| B754_nan _ _ _ _ _ => false
| B754_finite _ _ _ _ _ _ => true
end.
(** ** Decidable equality *)
Definition Beq_dec: forall (f1 f2: binary_float), {f1 = f2} + {f1 <> f2}.
(** Conversion from an integer.  Round to nearest. *)
Definition BofZ (n: Z) : binary_float :=
binary_normalize prec emax prec_gt_0_ Hmax mode_NE n 0 false.
(** Commutation properties with addition, subtraction, multiplication. *)
(** Rounding to odd the argument of [BofZ]. *)
Definition int_round_odd (x: Z) (p: Z) :=
(if Z.eqb (x mod 2^p) 0 || Z.odd (x / 2^p) then x / 2^p else x / 2^p + 1) * 2^p.
(** ** Conversion from a FP number to an integer *)
(** Always rounds toward zero. *)
Definition ZofB (f: binary_float): option Z :=
match f with
| B754_finite _ _ s m (Zpos e) _ => Some (cond_Zopp s (Zpos m) * Z.pow_pos radix2 e)%Z
| B754_finite _ _ s m 0 _ => Some (cond_Zopp s (Zpos m))
| B754_finite _ _ s m (Zneg e) _ => Some (cond_Zopp s (Zpos m / Z.pow_pos radix2 e))%Z
| B754_zero _ _ _ => Some 0%Z
| _ => None
end.
(** Interval properties. *)
Remark Ztrunc_range_pos:
forall x, 0 < Ztrunc x -> (IZR (Ztrunc x) <= x < IZR (Ztrunc x + 1)%Z)%R.
Remark Ztrunc_range_zero:
forall x, Ztrunc x = 0 -> (-1 < x < 1)%R.
(** For representable integers, [ZofB] is left inverse of [BofZ]. *)
(** Compatibility with subtraction *)
Remark Zfloor_minus:
forall x n, Zfloor (x - IZR n) = Zfloor x - n.
(** A variant of [ZofB] that bounds the range of representable integers. *)
Definition ZofB_range (f: binary_float) (zmin zmax: Z): option Z :=
match ZofB f with
| None => None
| Some z => if Z.leb zmin z && Z.leb z zmax then Some z else None
end.
(** ** Algebraic identities *)
(** Commutativity of addition and multiplication *)
(** Multiplication by 2 is diagonal addition. *)
(** Divisions that can be turned into multiplications by an inverse *)
Definition Bexact_inverse_mantissa := Z.iter (prec - 1) xO xH.
Remark Bexact_inverse_mantissa_value:
Zpos Bexact_inverse_mantissa = 2 ^ (prec - 1).
Remark Bexact_inverse_mantissa_digits2_pos:
Z.pos (digits2_pos Bexact_inverse_mantissa) = prec.
Remark bounded_Bexact_inverse:
forall e,
emin <= e <= emax - prec <-> bounded prec emax Bexact_inverse_mantissa e = true.
Program Definition Bexact_inverse (f: binary_float) : option binary_float :=
match f with
| B754_finite _ _ s m e B =>
if Pos.eq_dec m Bexact_inverse_mantissa then
let e' := -e - (prec - 1) * 2 in
if Z_le_dec emin e' then
if Z_le_dec e' emax then
Some(B754_finite _ _ s m e' _)
else None else None else None
| _ => None
end.
Next Obligation.
rewrite <- bounded_Bexact_inverse in B. rewrite <- bounded_Bexact_inverse.
unfold emin in *. omega.
Qed.
Proof with (try discriminate).
intros f f' EI. unfold Bexact_inverse in EI. destruct f as [s|s|s p H|s m e H]...
destruct (Pos.eq_dec m Bexact_inverse_mantissa)...
set (e' := -e - (prec - 1) * 2) in *.
destruct (Z_le_dec emin e')...
destruct (Z_le_dec e' emax)...
inversion EI; clear EI; subst f' m.
split. auto. split. auto. split. unfold B2R. rewrite Bexact_inverse_mantissa_value.
unfold F2R; simpl. rewrite IZR_cond_Zopp.
rewrite <- ! cond_Ropp_mult_l.
red in prec_gt_0_.
replace (IZR (2 ^ (prec - 1))) with (bpow radix2 (prec - 1))
by (symmetry; apply (IZR_Zpower radix2); omega).
rewrite <- ! bpow_plus.
replace (prec - 1 + e') with (- (prec - 1 + e)) by (unfold e'; omega).
rewrite bpow_opp. unfold cond_Ropp; destruct s; auto.
rewrite Ropp_inv_permute. auto. apply Rgt_not_eq. apply bpow_gt_0.
split. simpl. apply F2R_neq_0. destruct s; simpl in H; discriminate.
auto.
Qed.
(** ** Conversion from scientific notation *)
(** Russian peasant exponentiation *)
Fixpoint pos_pow (x y: positive) : positive :=
match y with
| xH => x
| xO y => Pos.square (pos_pow x y)
| xI y => Pos.mul x (Pos.square (pos_pow x y))
end.
(** Given a base [base], a mantissa [m] and an exponent [e], the following function computes the FP number closest to [m * base ^ e], using round to odd, ties break to even. The algorithm is naive, computing [base ^ |e|] exactly before doing a multiplication or division with [m].  However, we treat specially very large or very small values of [e], when the result is known to be [+infinity] or [0.0] respectively. *)
Definition Bparse (base: positive) (m: positive) (e: Z): binary_float :=
match e with
| Z0 =>
BofZ (Zpos m)
| Zpos p =>
if e * Z.log2 (Zpos base) <? emax
then BofZ (Zpos m * Zpos (pos_pow base p))
else B754_infinity _ _ false
| Zneg p =>
if e * Z.log2 (Zpos base) + Z.log2_up (Zpos m) <? emin
then B754_zero _ _ false
else FF2B prec emax _ (proj1 (Bdiv_correct_aux prec emax prec_gt_0_ Hmax mode_NE
false m Z0 false (pos_pow base p) Z0))
end.
(** Properties of [Z.log2] and [Z.log2_up]. *)
(** Overflow and underflow conditions. *)
(** Correctness of Bparse *)

Theorem Bparse_correct:
forall b m e (BASE: 2 <= Zpos b),
let base := {| radix_val := Zpos b; radix_prop := Zle_imp_le_bool _ _ BASE |} in
let r := round radix2 fexp (round_mode mode_NE) (IZR (Zpos m) * bpow base e) in
if Rlt_bool (Rabs r) (bpow radix2 emax) then
B2R _ _ (Bparse b m e) = r
/\ is_finite _ _ (Bparse b m e) = true
/\ Bsign _ _ (Bparse b m e) = false
else
B2FF _ _ (Bparse b m e) = F754_infinity false.