(** This file is part of the Flocq formalization of floating-point arithmetic in Coq: http://flocq.gforge.inria.fr/  Copyright (C) 2010-2013 Sylvie Boldo #<br /># Copyright (C) 2010-2013 Guillaume Melquiond  This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version.  This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the COPYING file for more details. *)
(** * IEEE-754 arithmetic *)
Section AnyRadix.
Inductive full_float :=
| F754_zero : bool -> full_float
| F754_infinity : bool -> full_float
| F754_nan : bool -> positive -> full_float
| F754_finite : bool -> positive -> Z -> full_float.
Definition FF2R beta x :=
match x with
| F754_finite s m e => F2R (Float beta (cond_Zopp s (Zpos m)) e)
| _ => 0%R
end.
End AnyRadix.
Section Binary.
Arguments exist {A P} x _.
(** [prec] is the number of bits of the mantissa including the implicit one; [emax] is the exponent of the infinities. For instance, binary32 is defined by [prec = 24] and [emax = 128]. *)
Variable prec emax : Z.
Context (prec_gt_0_ : Prec_gt_0 prec).
Hypothesis Hmax : (prec < emax)%Z.
Let emin := (3 - emax - prec)%Z.
Let fexp := FLT_exp emin prec.
Instance fexp_correct : Valid_exp fexp := FLT_exp_valid emin prec.
Instance fexp_monotone : Monotone_exp fexp := FLT_exp_monotone emin prec.
Definition canonic_mantissa m e :=
Zeq_bool (fexp (Zpos (digits2_pos m) + e)) e.
Definition bounded m e :=
andb (canonic_mantissa m e) (Zle_bool e (emax - prec)).
Definition valid_binary x :=
match x with
| F754_finite _ m e => bounded m e
| F754_nan _ pl => (Zpos (digits2_pos pl) <? prec)%Z
| _ => true
end.
(** Basic type used for representing binary FP numbers. Note that there is exactly one such object per FP datum. *)
Definition nan_pl := {pl | (Zpos (digits2_pos pl) <? prec)%Z  = true}.
Inductive binary_float :=
| B754_zero : bool -> binary_float
| B754_infinity : bool -> binary_float
| B754_nan : bool -> nan_pl -> binary_float
| B754_finite : bool ->
forall (m : positive) (e : Z), bounded m e = true -> binary_float.
Definition FF2B x :=
match x as x return valid_binary x = true -> binary_float with
| F754_finite s m e => B754_finite s m e
| F754_infinity s => fun _ => B754_infinity s
| F754_zero s => fun _ => B754_zero s
| F754_nan b pl => fun H => B754_nan b (exist pl H)
end.
Definition B2FF x :=
match x with
| B754_finite s m e _ => F754_finite s m e
| B754_infinity s => F754_infinity s
| B754_zero s => F754_zero s
| B754_nan b (exist pl _) => F754_nan b pl
end.
Definition B2R f :=
match f with
| B754_finite s m e _ => F2R (Float radix2 (cond_Zopp s (Zpos m)) e)
| _ => 0%R
end.

Theorem match_FF2B :
forall {T} fz fi fn ff x Hx,
match FF2B x Hx return T with
| B754_zero sx => fz sx
| B754_infinity sx => fi sx
| B754_nan b (exist p _) => fn b p
| B754_finite sx mx ex _ => ff sx mx ex
end =
match x with
| F754_zero sx => fz sx
| F754_infinity sx => fi sx
| F754_nan b p => fn b p
| F754_finite sx mx ex => ff sx mx ex
end.