diff --git a/byterun/floats.c b/byterun/floats.c index 4d2494cfb542..48010eac4f77 100644 --- a/byterun/floats.c +++ b/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))); diff --git a/stdlib/float.ml b/stdlib/float.ml index 3cd010062d3f..33d538167856 100644 --- a/stdlib/float.ml +++ b/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 diff --git a/stdlib/float.mli b/stdlib/float.mli index f7b4cd8d682a..5da1a86d8d94 100644 --- a/stdlib/float.mli +++ b/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. *)