(** Nan payload operations for single <-> double conversions. *)

Definition expand_pl (pl: nan_pl 24) : nan_pl 53.Definition of_single_pl (s:bool) (pl:nan_pl 24) : (bool * nan_pl 53) :=
  (s,
   if Archi.float_of_single_preserves_sNaN
   then expand_pl pl
   else transform_quiet_pl (expand_pl pl)).Definition reduce_pl (pl: nan_pl 53) : nan_pl 24.Definition to_single_pl (s:bool) (pl:nan_pl 53) : (bool * nan_pl 24) :=
  (s, reduce_pl (transform_quiet_pl pl)).(** NaN payload operations for opposite and absolute value. *)

Definition neg_pl (s:bool) (pl:nan_pl 53) := (negb s, pl).Definition abs_pl (s:bool) (pl:nan_pl 53) := (false, pl).(** 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_pl (x y: binary64) : bool*nan_pl 53 :=
  match x, y with
  | B754_nan s1 pl1, B754_nan s2 pl2 =>
      if Archi.choose_binop_pl_64 s1 pl1 s2 pl2
      then (s2, transform_quiet_pl pl2)
      else (s1, transform_quiet_pl pl1)
  | B754_nan s1 pl1, _ => (s1, transform_quiet_pl pl1)
  | _, B754_nan s2 pl2 => (s2, transform_quiet_pl pl2)
  | _, _ => Archi.default_pl_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_pl.(**r opposite (change sign) *)
Definition abs: float -> float := Babs _ _ abs_pl.(**r absolute value (set sign to [+]) *)
Definition add: float -> float -> float :=
  Bplus 53 1024 __ __ binop_pl mode_NE.(**r addition *)
Definition sub: float -> float -> float :=
  Bminus 53 1024 __ __ binop_pl mode_NE.(**r subtraction *)
Definition mul: float -> float -> float :=
  Bmult 53 1024 __ __ binop_pl mode_NE.(**r multiplication *)
Definition div: float -> float -> float :=
  Bdiv 53 1024 __ __ binop_pl mode_NE.(**r division *)
Definition cmp (c:comparison) (f1 f2: float) : bool := (**r comparison *)
  cmp_of_comparison c (Bcompare _ _ f1 f2).(** Conversions *)

Definition of_single: float32 -> float := Bconv _ _ 53 1024 __ __ of_single_pl mode_NE.Definition to_single: float -> float32 := Bconv _ _ 24 128 __ __ to_single_pl 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.

(* Specifications: *)
Theorem add_commut: forall x y, is_nan _ _ x = false \/ is_nan _ _ y = false -> add x y = add y x.
Theorem mul_commut: forall x y, is_nan _ _ x = false \/ is_nan _ _ y = false -> mul x y = mul y x.
Theorem mul2_add: forall f, add f f = mul f (of_int (Int.repr 2%Z)).
Theorem add_commut: forall x y, is_nan _ _ x = false \/ is_nan _ _ y = false -> add x y = add y x.
Theorem mul_commut: forall x y, is_nan _ _ x = false \/ is_nan _ _ y = false -> mul x y = mul y x.
Theorem mul2_add: forall f, add f f = mul f (of_int (Int.repr 2%Z)).