Add primitive floats to 'native_compute'

* Float added to is_value/get_value to avoid stack overflows
  (cf. #7646)

* beware of the use of Array.map with floats (cf. comment in the
  makeblock function)

NB: From here one, the configure option "-native-compiler no"
is no longer needed.

1 files changed, 34 insertions, 6 deletions

diff --git a/kernel/float64.ml b/kernel/float64.ml
index 351661f44d..c0611f37a0 100644
--- a/kernel/float64.ml
+++ b/kernel/float64.ml
@@ -13,12 +13,21 @@
 type t = float
 
 let is_nan f = f <> f
+let is_infinity f = f = infinity
+let is_neg_infinity f = f = neg_infinity
 
 (* OCaml give a sign to nan values which should not be displayed as all nan are
  * considered equal *)
 let to_string f = if is_nan f then "nan" else string_of_float f
 let of_string = float_of_string
 
+(* Compiles a float to OCaml code *)
+let compile f =
+  let s =
+    if is_nan f then "nan" else if is_neg_infinity f then "neg_infinity"
+    else Printf.sprintf "%h" f in
+  Printf.sprintf "Float64.of_float (%s)" s
+
 let of_float f = f
 
 let opp = ( ~-. )
@@ -37,6 +46,7 @@ let compare x y =
       else FNotComparable (* NaN case *)
     )
   )
+[@@ocaml.inline always]
 
 type float_class =
   | PNormal | NNormal | PSubn | NSubn | PZero | NZero | PInf | NInf | NaN
@@ -48,19 +58,32 @@ let classify x =
   | FP_zero -> if 0. < 1. /. x then PZero else NZero
   | FP_infinite -> if 0. < x then PInf else NInf
   | FP_nan -> NaN
+[@@ocaml.inline always]
+
+let mul x y = x *. y
+[@@ocaml.inline always]
+
+let add x y = x +. y
+[@@ocaml.inline always]
+
+let sub x y = x -. y
+[@@ocaml.inline always]
+
+let div x y = x /. y
+[@@ocaml.inline always]
+
+let sqrt x = sqrt x
+[@@ocaml.inline always]
 
-let mul = ( *. )
-let add = ( +. )
-let sub = ( -. )
-let div = ( /. )
-let sqrt = sqrt
+let of_int63 x = Uint63.to_float x
+[@@ocaml.inline always]
 
-let of_int63 = Uint63.to_float
 let prec = 53
 let normfr_mantissa f =
   let f = abs f in
   if f >= 0.5 && f < 1. then Uint63.of_float (ldexp f prec)
   else Uint63.zero
+[@@ocaml.inline always]
 
 let eshift = 2101 (* 2*emax + prec *)
 
@@ -73,8 +96,10 @@ let frshiftexp f =
   | FP_normal | FP_subnormal ->
     let (m, e) = frexp f in
     m, Uint63.of_int (e + eshift)
+[@@ocaml.inline always]
 
 let ldshiftexp f e = ldexp f (snd (Uint63.to_int2 e) - eshift)
+[@@ocaml.inline always]
 
 let eta_float = ldexp 1. (-1074) (* smallest positive float (subnormal) *)
 
@@ -91,14 +116,17 @@ let next_up f =
        ldexp (f +. epsilon_float /. 2.) e
      else
        ldexp (-0.5 +. epsilon_float /. 4.) e
+[@@ocaml.inline always]
 
 let next_down f = -.(next_up (-.f))
+[@@ocaml.inline always]
 
 let equal f1 f2 =
   match classify_float f1 with
   | FP_normal | FP_subnormal | FP_infinite -> (f1 = f2)
   | FP_nan -> is_nan f2
   | FP_zero -> f1 = f2 && 1. /. f1 = 1. /. f2 (* OCaml consider 0. = -0. *)
+[@@ocaml.inline always]
 
 let hash =
   (* Hashtbl.hash already considers all NaNs as equal,