diff --git a/Makefile b/Makefile
index 6b917cf38ef061f06e297d00a414b01557f93c12..e55d0d432ed93c0dcbb1a7c79d1d705b4c0f366a 100644
--- a/Makefile
+++ b/Makefile
@@ -841,7 +841,7 @@ NUMERORS_FILES:= \
values/numerors/numerors_value domains/numerors/numerors_domain
ifeq ($(HAS_MPFR),yes)
-PLUGIN_REQUIRES+= gmp
+PLUGIN_REQUIRES+= mlmpfr
PLUGIN_TESTS_DIRS+=value/numerors
NUMERORS_CMO:= $(NUMERORS_FILES)
else
diff --git a/configure.in b/configure.in
index e98ef587598339a0405baf03cc58c93a361943e5..8b9759e116f266972adef251079e8089385705d6 100644
--- a/configure.in
+++ b/configure.in
@@ -388,8 +388,8 @@ fi;
AC_MSG_CHECKING(for MPFR)
-MPFR_PATH=$($OCAMLFIND query gmp 2>/dev/null | tr -d '\r\n')
-if test -f "$MPFR_PATH/gmp.$DYN_SUFFIX" -a -f "$MPFR_PATH/mpfr.cmx" ; then
+MPFR_PATH=$($OCAMLFIND query mlmpfr 2>/dev/null | tr -d '\r\n')
+if test -f "$MPFR_PATH/mlmpfr.$DYN_SUFFIX"; then
HAS_MPFR="yes";
AC_MSG_RESULT(found)
else
diff --git a/src/plugins/value/values/numerors/numerors_float.ml b/src/plugins/value/values/numerors/numerors_float.ml
index 07bdd9f9f455aee8a939051bcca4a008c1f73c8c..2b9fb12fa8ac2bab83a6ffb131cff46a5e564a14 100644
--- a/src/plugins/value/values/numerors/numerors_float.ml
+++ b/src/plugins/value/values/numerors/numerors_float.ml
@@ -25,81 +25,59 @@ open Numerors_utils
module P = Precisions
(* Type declaration *)
-type t = P.t * Mpfrf.t
+type t = P.t * Mpfr.mpfr_float
(* Pretty printer *)
-let pretty fmt (_, f) = Mpfrf.print fmt f
+let pretty fmt (_, f) =
+ let (s,e) = Mpfr.get_str ~base:10 ~size:0 f ~rnd:Mpfr.To_Nearest in
+ if not (Mpfr.number_p f) then Format.fprintf fmt "%s" s
+ else if s = "" then Format.fprintf fmt "0."
+ else if s.[0] = '-'
+ then Format.fprintf fmt "-0.%sE%s" String.(sub s 1 (length s - 1)) e
+ else Format.fprintf fmt "0.%sE%s" s e
(* Get back the MPFR rounding mode *)
let rounding = function
- | Rounding.Near -> Mpfr.Near
- | Rounding.Down -> Mpfr.Down
- | Rounding.Up -> Mpfr.Up
-
-(* Apply an Mpfr function to an Mpfrf object *)
-let convert f = fun x rnd ->
- let x' = Mpfrf.to_mpfr x in
- let r = Mpfr.init () in
- let _ = f r x' rnd in
- Mpfrf.of_mpfr r
-
+ | Rounding.Near -> Mpfr.To_Nearest
+ | Rounding.Down -> Mpfr.Toward_Minus_Infinity
+ | Rounding.Up -> Mpfr.Toward_Plus_Infinity
(*-----------------------------------------------------------------------------
* Internal functions to handle the precisions of MPFR numbers
*---------------------------------------------------------------------------*)
-(* Set the default precision *)
-let set_precision =
- Mpfr.set_default_prec (P.get P.Real) ;
- let actual_precision = ref P.Real in
- fun prec ->
- if not (P.eq prec !actual_precision) then
- (Mpfr.set_default_prec (P.get prec) ; actual_precision := prec)
-
-(* Monad which sets the default precision before calling the given function f.
- Returns the tuple composed of the precision and the return of f. *)
-let ( >>- ) prec f = set_precision prec ; prec, f ()
-[@@inline]
-
(* Internal : change the precision *)
-let change_prec ?(rnd = Mpfr.Near) prec (p, x) =
+let change_prec ?(rnd = Mpfr.To_Nearest) prec (p, x) =
if not (P.eq p prec) then
- let r = Mpfr.init () in
- let _ = Mpfr.set r (Mpfrf.to_mpfr x) rnd in
- Mpfrf.of_mpfr r
+ Mpfr.make_from_mpfr ~prec:(P.get prec) ~rnd x
else x
[@@inline]
(* Returns a function which apply the rounding of its optionnal parameter rnd
and change the precision according to its optionnal parameter prec before
calling the unary function f on an input of type t *)
-let unary_mpfrf f =
+let unary_mpfrf (f:?rnd:Mpfr.mpfr_rnd_t -> ?prec:int -> Mpfr.mpfr_float -> Mpfr.mpfr_float) =
fun ?(rnd = Rounding.Near) ?(prec = P.Real) x ->
- prec >>- fun () ->
- f (change_prec prec x) (rounding rnd)
+ prec, f ~rnd:(rounding rnd) ~prec:(P.get prec) (change_prec prec x)
(* Returns a function which apply the rounding of its optionnal parameter rnd
and change the precision according to its optionnal parameter prec before
calling the binary function f on two inputs of type t *)
-let binary_mpfrf f =
+let binary_mpfrf (f :?rnd:Mpfr.mpfr_rnd_t -> ?prec:int -> Mpfr.mpfr_float -> Mpfr.mpfr_float -> Mpfr.mpfr_float) =
fun ?(rnd = Rounding.Near) ?(prec = P.Real) x y ->
- prec >>- fun () ->
- f (change_prec prec x) (change_prec prec y) (rounding rnd)
+ prec, f ~rnd:(rounding rnd) ~prec:(P.get prec) (change_prec prec x) (change_prec prec y)
(*-----------------------------------------------------------------------------
* Constructors
*---------------------------------------------------------------------------*)
-let of_mpfr p f = p, f
-
let of_int ?(rnd = Rounding.Near) ?(prec = P.Real) i =
- prec >>- fun () -> Mpfrf.of_int i (rounding rnd)
+ prec, Mpfr.make_from_int ~prec:(P.get prec) i ~rnd:(rounding rnd)
let of_float ?(rnd = Rounding.Near) ?(prec = P.Real) f =
- prec >>- fun () -> Mpfrf.of_float f (rounding rnd)
+ prec, Mpfr.make_from_float f ~rnd:(rounding rnd) ~prec:(P.get prec)
let of_string ?(rnd = Rounding.Near) ?(prec = P.Real) str =
- prec >>- fun () ->
let l = String.length str - 1 in
let last = Char.lowercase_ascii str.[l] in
let str =
@@ -107,14 +85,14 @@ let of_string ?(rnd = Rounding.Near) ?(prec = P.Real) str =
then String.sub str 0 l
else str
in
- (* base=0 to let Mpfr infer the base, depending of the encoding of s. *)
- Mpfrf.of_mpfr (Mpfr.init_set_str str ~base:0 (rounding rnd))
+ (* base is not given to let Mpfr infer the base, depending of the encoding of s. *)
+ prec, Mpfr.make_from_str ~prec:(P.get prec) str ~rnd:(rounding rnd)
let pos_zero prec = of_float ~prec 0.0
let neg_zero prec = of_float ~prec (~-. 0.0)
-let pos_inf prec = of_mpfr prec @@ Mpfrf.of_float infinity Mpfr.Near
-let neg_inf prec = of_mpfr prec @@ Mpfrf.of_float neg_infinity Mpfr.Near
+let pos_inf prec = prec, Mpfr.make_from_float infinity ~rnd:Mpfr.To_Nearest ~prec:(P.get prec)
+let neg_inf prec = prec, Mpfr.make_from_float neg_infinity ~rnd:Mpfr.To_Nearest ~prec:(P.get prec)
(*-----------------------------------------------------------------------------
@@ -124,7 +102,7 @@ let compare (px, nx) (py, ny) =
if not (Precisions.eq px py) then
Self.fatal
"Numerors: impossible to compare two numbers with different precisions"
- else Mpfrf.cmp nx ny
+ else Mpfr.cmp nx ny
let eq a b = compare a b = 0
let le a b = compare a b <= 0
let lt a b = compare a b < 0
@@ -139,12 +117,9 @@ let max x y = if compare x y <= 0 then y else x
* Getters on floats
*---------------------------------------------------------------------------*)
let sign (_, x) =
- let s = Mpfrf.sgn x in
- if s = 0 then
- (* Ugly fix because the sign of a MPFR zero is zero ! FUCK IT *)
- let fx = Mpfrf.to_float x in
- Sign.of_int @@ int_of_float @@ copysign 1.0 fx
- else Sign.of_int s
+ match Mpfr.sgn x with
+ | Positive -> Sign.Positive
+ | Negative -> Sign.Negative
let prec (p, _) = p
@@ -155,19 +130,18 @@ let prec (p, _) = p
representation by one. *)
let exponent (prec, x as f) =
if eq f (pos_zero prec) then min_int
- else (Mpfr.get_exp (Mpfrf.to_mpfr x)) - 1
+ else (Mpfr.get_exp x) - 1
-let significand (prec, x) = prec >>- fun () ->
- let significand = Mpfrf.to_mpfr x in
- let _ = Mpfr.set_exp significand 1 in
- Mpfrf.abs (Mpfrf.of_mpfr significand) Mpfr.Near
+let significand (prec, x) =
+ let significand = Mpfr.set_exp x 1 in
+ prec, Mpfr.abs significand ~rnd:Mpfr.To_Nearest ~prec:(P.get prec)
(*-----------------------------------------------------------------------------
* Methods to check properties on floats
*---------------------------------------------------------------------------*)
-let is_nan (_, x) = Mpfrf.nan_p x
-let is_inf (_, x) = Mpfrf.inf_p x
+let is_nan (_, x) = Mpfr.nan_p x
+let is_inf (_, x) = Mpfr.inf_p x
let is_pos f = Sign.is_pos (sign f)
let is_neg f = Sign.is_neg (sign f)
@@ -182,33 +156,33 @@ let is_strictly_neg f = is_neg f && not (is_a_zero f)
(*-----------------------------------------------------------------------------
* Functions without rounding errors
*---------------------------------------------------------------------------*)
-let neg (p, x) = p >>- fun () -> Mpfrf.neg x Mpfr.Near
-let abs (p, x) = p >>- fun () -> Mpfrf.abs x Mpfr.Near
+let neg (p, x) = p, Mpfr.neg x ~rnd:Mpfr.To_Nearest ~prec:(P.get p)
+let abs (p, x) = p, Mpfr.abs x ~rnd:Mpfr.To_Nearest ~prec:(P.get p)
(*-----------------------------------------------------------------------------
* Operators
*---------------------------------------------------------------------------*)
-let add = binary_mpfrf Mpfrf.add
-let sub = binary_mpfrf Mpfrf.sub
-let mul = binary_mpfrf Mpfrf.mul
-let div = binary_mpfrf Mpfrf.div
-let pow = binary_mpfrf Mpfrf.pow
+let add = binary_mpfrf Mpfr.add
+let sub = binary_mpfrf Mpfr.sub
+let mul = binary_mpfrf Mpfr.mul
+let div = binary_mpfrf Mpfr.div
+let pow = binary_mpfrf Mpfr.pow
let pow_int =
fun ?(rnd = Rounding.Near) ?(prec = P.Real) x n ->
- prec >>- fun () -> Mpfrf.pow_int (change_prec prec x) n (rounding rnd)
+ prec, Mpfr.pow_int (change_prec prec x) n ~rnd:(rounding rnd) ~prec:(P.get prec)
(*-----------------------------------------------------------------------------
* Functions with rounding errors
*---------------------------------------------------------------------------*)
-let square = unary_mpfrf (fun x -> Mpfrf.mul x x)
-let sqrt = unary_mpfrf Mpfrf.sqrt
-let log = unary_mpfrf @@ convert Mpfr.log
-let exp = unary_mpfrf @@ convert Mpfr.exp
-let sin = unary_mpfrf @@ convert Mpfr.sin
-let cos = unary_mpfrf @@ convert Mpfr.cos
-let tan = unary_mpfrf @@ convert Mpfr.tan
+let square = unary_mpfrf (fun ?rnd ?prec x -> Mpfr.mul ?rnd ?prec x x)
+let sqrt = unary_mpfrf Mpfr.sqrt
+let log = unary_mpfrf @@ Mpfr.log
+let exp = unary_mpfrf @@ Mpfr.exp
+let sin = unary_mpfrf @@ Mpfr.sin
+let cos = unary_mpfrf @@ Mpfr.cos
+let tan = unary_mpfrf @@ Mpfr.tan
(*-----------------------------------------------------------------------------
@@ -222,14 +196,10 @@ let apply_sign ~src ~dst =
* Next and prev float
*---------------------------------------------------------------------------*)
let next_float (p, x) =
- let x' = Mpfrf.to_mpfr x in
- Mpfr.nextabove x' ;
- p, Mpfrf.of_mpfr x'
+ p, Mpfr.nextabove x
let prev_float (p, x) =
- let x' = Mpfrf.to_mpfr x in
- Mpfr.nextbelow x' ;
- p, Mpfrf.of_mpfr x'
+ p, Mpfr.nextbelow x
(*-----------------------------------------------------------------------------