Add to Float arithmetic operators, is_finite,..., round, min/max.

byterun/floats.c

@@ -377,6 +377,11 @@ CAMLprim value caml_exp_float(value f)
   return caml_copy_double(exp(Double_val(f)));
 }
 
+CAMLprim value caml_round_float(value f)
+{
+  return caml_copy_double(round(Double_val(f)));
+}
+
 CAMLprim value caml_floor_float(value f)
 {
   return caml_copy_double(floor(Double_val(f)));

stdlib/float.ml

@@ -22,9 +22,20 @@ external div : float -> float -> float = "%divfloat"
 external rem : float -> float -> float = "caml_fmod_float" "fmod"
   [@@unboxed] [@@noalloc]
 external abs : float -> float = "%absfloat"
+external ( ~-. ) : float -> float = "%negfloat"
+external ( ~+. ) : float -> float = "%identity"
+external ( +. ) : float -> float -> float = "%addfloat"
+external ( -. ) : float -> float -> float = "%subfloat"
+external ( *. ) : float -> float -> float = "%mulfloat"
+external ( /. ) : float -> float -> float = "%divfloat"
+external ( ** ) : float -> float -> float = "caml_power_float" "pow"
+  [@@unboxed] [@@noalloc]
 let infinity = Pervasives.infinity
 let neg_infinity = Pervasives.neg_infinity
+let is_finite (x: float) = x -. x = 0.
+let is_infinite (x: float) = 1. /. x = 0.
 let nan = Pervasives.nan
+let is_nan (x: float) = x <> x
 let pi = 0x1.921fb54442d18p+1
 let max_float = Pervasives.max_float
 let min_float = Pervasives.min_float
@@ -73,6 +84,8 @@ external sinh : float -> float = "caml_sinh_float" "sinh"
   [@@unboxed] [@@noalloc]
 external tanh : float -> float = "caml_tanh_float" "tanh"
   [@@unboxed] [@@noalloc]
+external round : float -> float = "caml_round_float" "round"
+  [@@unboxed] [@@noalloc]
 external ceil : float -> float = "caml_ceil_float" "ceil"
   [@@unboxed] [@@noalloc]
 external floor : float -> float = "caml_floor_float" "floor"
@@ -87,6 +100,21 @@ external modf : float -> float * float = "caml_modf_float"
 type t = float
 external compare : float -> float -> int = "%compare"
 let equal x y = compare x y = 0
+
+let min (x: float) (y: float) =
+  if x <= y then x (* not NaN *)
+  else if y <> y then x else y
+
+let max (x: float) (y: float) =
+  if x >= y then x (* not NaN *)
+  else if y <> y then x else y
+
+let nanmin (x: float) (y: float) =
+  if x <= y || x <> x then x else y
+
+let nanmax (x: float) (y: float) =
+  if x >= y || x <> x then x else y
+
 external seeded_hash_param : int -> int -> int -> float -> int = "caml_hash" [@@noalloc]
 let hash x = seeded_hash_param 10 100 0 x
 

stdlib/float.mli

@@ -45,6 +45,20 @@ external mul : float -> float -> float = "%mulfloat"
 external div : float -> float -> float = "%divfloat"
 (** Floating-point division. *)
 
+(** Re-export floating point infix operators so that, if these
+   operators were redefined by another module, it is possible to use
+   local opens to recover their original meaning.
+   Example: [Float.(x *. y)]. *)
+
+external ( ~-. ) : float -> float = "%negfloat"
+external ( ~+. ) : float -> float = "%identity"
+external ( +. ) : float -> float -> float = "%addfloat"
+external ( -. ) : float -> float -> float = "%subfloat"
+external ( *. ) : float -> float -> float = "%mulfloat"
+external ( /. ) : float -> float -> float = "%divfloat"
+external ( ** ) : float -> float -> float = "caml_power_float" "pow"
+  [@@unboxed] [@@noalloc]
+
 external rem : float -> float -> float = "caml_fmod_float" "fmod"
 [@@unboxed] [@@noalloc]
 (** [rem a b] returns the remainder of [a] with respect to [b].  The returned
@@ -60,6 +74,13 @@ val infinity : float
 val neg_infinity : float
 (** Negative infinity. *)
 
+val is_finite : float -> bool
+(** [is_finite x] says whether the number is finite i.e., not infinite
+   and not [nan]. *)
+
+val is_infinite : float -> bool
+(** [is_infinite x] says whether [x] is [infinity] or [neg_infinity]. *)
+
 val nan : float
 (** A special floating-point value denoting the result of an
     undefined operation such as [0.0 /. 0.0].  Stands for
@@ -68,6 +89,9 @@ val nan : float
     [=], [<], [<=], [>] and [>=] return [false] and [<>] returns [true]
     if one or both of their arguments is [nan]. *)
 
+val is_nan : float -> bool
+(** [is_nan x] returns [true] if and only if [x] represents a [nan]. *)
+
 val pi : float
 (** The constant pi. *)
 
@@ -204,6 +228,12 @@ external tanh : float -> float = "caml_tanh_float" "tanh"
 [@@unboxed] [@@noalloc]
 (** Hyperbolic tangent.  Argument is in radians. *)
 
+external round : float -> float = "caml_round_float" "round"
+                                    [@@unboxed] [@@noalloc]
+(** [round x] rounds [x] to the nearest integer with ties (fractional
+   values of 0.5) rounded away from zero, regardless of the current
+   rounding direction. *)
+
 external ceil : float -> float = "caml_ceil_float" "ceil"
 [@@unboxed] [@@noalloc]
 (** Round above to an integer value.
@@ -253,6 +283,23 @@ val compare: t -> t -> int
 val equal: t -> t -> bool
 (** The equal function for floating-point numbers, compared using {!compare}. *)
 
+val min : t -> t -> t
+(** [min x y] returns the minimum of [x] and [y] ignoring [nan] except
+   if both [x] and [y] are [nan], in which case [nan] is returned.  *)
+
+val max : t -> t -> t
+(** [max x y] returns the maximum of [x] and [y] ignoring [nan] except
+   if both [x] and [y] are [nan], in which case [nan] is returned. *)
+
+val nanmin : t -> t -> t
+(** [nanmin x y] returns the minimum of [x] and [y].  It returns [nan]
+   when [x] or [y] is [nan]. *)
+
+val nanmax : t -> t -> t
+(** [nanmax x y] returns the maximum of [x] and [y].  It returns [nan]
+   when [x] or [y] is [nan]. *)
+
+
 val hash: t -> int
 (** The hash function for floating-point numbers. *)