Module Float.
(** ** NaN payload manipulations *)
(** The following definitions are not part of the IEEE754 standard but apply to all architectures supported by CompCert. *)
(** Transform a Nan payload to a quiet Nan payload. *)
Definition transform_quiet_nan s p H : {x :float | is_nan _ _ x = true} :=
exist _ (B754_nan 53 1024 s _ (transform_quiet_nan_proof p H)) (eq_refl true).
(** Nan payload operations for single <-> double conversions. *)
Definition expand_nan s p H : {x | is_nan 53 1024 x = true} :=
exist _ (B754_nan 53 1024 s _ (expand_nan_proof p H)) (eq_refl true).
Definition of_single_nan (f : float32) : { x : float | is_nan _ _ x = true } :=
match f with
| B754_nan s p H =>
if Archi.float_of_single_preserves_sNaN
then expand_nan s p H
else transform_quiet_nan s _ (expand_nan_proof p H)
| _ => Archi.default_nan_64
end.
Definition reduce_nan s p H : {x : float32 | is_nan _ _ x = true} :=
exist _ (B754_nan 24 128 s _ (reduce_nan_proof p H)) (eq_refl true).
Definition to_single_nan (f : float) : { x : float32 | is_nan _ _ x = true } :=
match f with
| B754_nan s p H => reduce_nan s _ (transform_quiet_nan_proof p H)
| _ => Archi.default_nan_32
end.
(** NaN payload operations for opposite and absolute value. *)
Definition neg_nan (f : float) : { x : float | is_nan _ _ x = true } :=
match f with
| B754_nan s p H => exist _ (B754_nan 53 1024 (negb s) p H) (eq_refl true)
| _ => Archi.default_nan_64
end.
Definition abs_nan (f : float) : { x : float | is_nan _ _ x = true } :=
match f with
| B754_nan s p H => exist _ (B754_nan 53 1024 false p H) (eq_refl true)
| _ => Archi.default_nan_64
end.
(** The NaN payload operations for two-argument arithmetic operations are not part of the IEEE754 standard, but all architectures of Compcert share a similar NaN behavior, parameterized by: - a "default" payload which occurs when an operation generates a NaN from non-NaN arguments; - a choice function determining which of the payload arguments to choose, when an operation is given two NaN arguments. *)
Definition binop_nan (x y : float) : {x : float | is_nan 53 1024 x = true} :=
if Archi.fpu_returns_default_qNaN then Archi.default_nan_64 else
match x, y with
| B754_nan s1 pl1 H1, B754_nan s2 pl2 H2 =>
if Archi.choose_binop_pl_64 pl1 pl2
then transform_quiet_nan s2 pl2 H2
else transform_quiet_nan s1 pl1 H1
| B754_nan s1 pl1 H1, _ => transform_quiet_nan s1 pl1 H1
| _, B754_nan s2 pl2 H2 => transform_quiet_nan s2 pl2 H2
| _, _ => Archi.default_nan_64
end.
(** ** Operations over double-precision floats *)
Definition zero: float := B754_zero _ _ false. (**r the float [+0.0] *)
Definition eq_dec: forall (f1 f2: float), {f1 = f2} + {f1 <> f2} := Beq_dec _ _.
(** Arithmetic operations *)
Definition neg: float -> float := Bopp _ _ neg_nan. (**r opposite (change sign) *)
Definition abs: float -> float := Babs _ _ abs_nan. (**r absolute value (set sign to [+]) *)
Definition add: float -> float -> float :=
Bplus 53 1024 __ __ binop_nan mode_NE. (**r addition *)
Definition sub: float -> float -> float :=
Bminus 53 1024 __ __ binop_nan mode_NE. (**r subtraction *)
Definition mul: float -> float -> float :=
Bmult 53 1024 __ __ binop_nan mode_NE. (**r multiplication *)
Definition div: float -> float -> float :=
Bdiv 53 1024 __ __ binop_nan mode_NE. (**r division *)
Definition compare (f1 f2: float) : option Datatypes.comparison := (**r general comparison *)
Bcompare 53 1024 f1 f2.
Definition cmp (c:comparison) (f1 f2: float) : bool := (**r Boolean comparison *)
cmp_of_comparison c (compare f1 f2).
Definition ordered (f1 f2: float) : bool :=
ordered_of_comparison (compare f1 f2).
(** Conversions *)
Definition of_single: float32 -> float := Bconv _ _ 53 1024 __ __ of_single_nan mode_NE.
Definition to_single: float -> float32 := Bconv _ _ 24 128 __ __ to_single_nan mode_NE.
Definition to_int (f:float): option int := (**r conversion to signed 32-bit int *)
option_map Int.repr (ZofB_range _ _ f Int.min_signed Int.max_signed).
Definition to_intu (f:float): option int := (**r conversion to unsigned 32-bit int *)
option_map Int.repr (ZofB_range _ _ f 0 Int.max_unsigned).
Definition to_long (f:float): option int64 := (**r conversion to signed 64-bit int *)
option_map Int64.repr (ZofB_range _ _ f Int64.min_signed Int64.max_signed).
Definition to_longu (f:float): option int64 := (**r conversion to unsigned 64-bit int *)
option_map Int64.repr (ZofB_range _ _ f 0 Int64.max_unsigned).
Definition of_int (n:int): float := (**r conversion from signed 32-bit int *)
BofZ 53 1024 __ __ (Int.signed n).
Definition of_intu (n:int): float:= (**r conversion from unsigned 32-bit int *)
BofZ 53 1024 __ __ (Int.unsigned n).
Definition of_long (n:int64): float := (**r conversion from signed 64-bit int *)
BofZ 53 1024 __ __ (Int64.signed n).
Definition of_longu (n:int64): float:= (**r conversion from unsigned 64-bit int *)
BofZ 53 1024 __ __ (Int64.unsigned n).
Definition from_parsed (base:positive) (intPart:positive) (expPart:Z) : float :=
Bparse 53 1024 __ __ base intPart expPart.
(** Conversions between floats and their concrete in-memory representation as a sequence of 64 bits. *)
Definition to_bits (f: float): int64 := Int64.repr (bits_of_b64 f).
Definition of_bits (b: int64): float := b64_of_bits (Int64.unsigned b).
Definition from_words (hi lo: int) : float := of_bits (Int64.ofwords hi lo).
(** ** Properties *)
(** Below are the only properties of floating-point arithmetic that we rely on in the compiler proof. *)
(** Some tactics **)
Ltac compute_this val :=
let x := fresh in set val as x in *; vm_compute in x; subst x.
Ltac smart_omega :=
simpl radix_val in *; simpl Z.pow in *;
compute_this Int.modulus; compute_this Int.half_modulus;
compute_this Int.max_unsigned;
compute_this Int.min_signed; compute_this Int.max_signed;
compute_this Int64.modulus; compute_this Int64.half_modulus;
compute_this Int64.max_unsigned;
compute_this (Z.pow_pos 2 1024); compute_this (Z.pow_pos 2 53); compute_this (Z.pow_pos 2 52); compute_this (Z.pow_pos 2 32);
zify; omega.
(** Commutativity properties of addition and multiplication. *)

Theorem mul_commut:
forall x y, is_nan _ _ x = false \/ is_nan _ _ y = false -> mul x y = mul y x.