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. *)
(** Multiplication by 2 is diagonal addition. *)
(** Divisions that can be turned into multiplication by an inverse. *)
Definition exact_inverse : float -> option float := Bexact_inverse 53 1024 __ __.
(** Properties of comparisons. *)
(** Properties of conversions to/from in-memory representation. The conversions are bijective (one-to-one). *)
(** Conversions between floats and unsigned ints can be defined in terms of conversions between floats and signed ints. (Most processors provide only the latter, forcing the compiler to emulate the former.)   *)
Definition ox8000_0000 := Int.repr Int.half_modulus.  (**r [0x8000_0000] *)
(** Conversions from ints to floats can be defined as bitwise manipulations over the in-memory representation.  This is what the PowerPC port does. The trick is that [from_words 0x4330_0000 x] is the float [2^52 + of_intu x]. *)
Definition ox4330_0000 := Int.repr 1127219200.        (**r [0x4330_0000] *)
Definition ox4530_0000 := Int.repr 1160773632.        (**r [0x4530_0000] *)
(** Conversions from 64-bit integers can be expressed in terms of conversions from their 32-bit halves. *)
(** Conversions from unsigned longs can be expressed in terms of conversions from signed longs. If the unsigned long is too big, a round-to-odd must be performed on it to avoid double rounding. *)

Theorem of_longu_of_long_2:
forall x,
Int64.ltu x (Int64.repr Int64.half_modulus) = false ->
of_longu x = mul (of_long (Int64.or (Int64.shru x Int64.one)
(Int64.and x Int64.one)))
(of_int (Int.repr 2)).