Fix static evaluation of caml_int64_float_of_bits

Do not statically evaluate caml_int64_float_of_bits when it would
result in a non-canonical NaN, since there is no JavaScript syntax for
non-canonical NaNs.

Author: vouillon

compiler/lib/eval.ml

@@ -139,7 +139,7 @@ let nativeint_shiftop (l : constant list) (f : int32 -> int -> int32) : constant
   | [ NativeInt i; Int j ] -> Some (NativeInt (f i (Targetint.to_int_exn j)))
   | _ -> None
 
-let eval_prim x =
+let eval_prim ~target x =
   match x with
   | Not, [ Int i ] -> bool (Targetint.is_zero i)
   | Lt, [ Int i; Int j ] -> bool Targetint.(i < j)
@@ -231,7 +231,13 @@ let eval_prim x =
       (* int32 *)
       | "caml_int32_bits_of_float", [ Float f ] ->
           int32 (Int32.bits_of_float (Int64.float_of_bits f))
-      | "caml_int32_float_of_bits", [ Int32 i ] -> Some (float (Int32.float_of_bits i))
+      | "caml_int32_float_of_bits", [ Int32 i ]
+        when match target with
+             | `JavaScript ->
+                 let f = Int32.float_of_bits i in
+                 (not (Float.is_nan f))
+                 || Int64.equal (Int64.bits_of_float f) (Int64.bits_of_float nan)
+             | `Wasm -> true -> Some (float (Int32.float_of_bits i))
       | "caml_int32_of_float", [ Float f ] ->
           int32 (Int32.of_float (Int64.float_of_bits f))
       | "caml_int32_to_float", [ Int32 i ] -> Some (float (Int32.to_float i))
@@ -258,8 +264,13 @@ let eval_prim x =
       (* nativeint *)
       | "caml_nativeint_bits_of_float", [ Float f ] ->
           nativeint (Int32.bits_of_float (Int64.float_of_bits f))
-      | "caml_nativeint_float_of_bits", [ NativeInt i ] ->
-          Some (float (Int32.float_of_bits i))
+      | "caml_nativeint_float_of_bits", [ NativeInt i ]
+        when match target with
+             | `JavaScript ->
+                 let f = Int32.float_of_bits i in
+                 (not (Float.is_nan f))
+                 || Int64.equal (Int64.bits_of_float f) (Int64.bits_of_float nan)
+             | `Wasm -> true -> Some (float (Int32.float_of_bits i))
       | "caml_nativeint_of_float", [ Float f ] ->
           nativeint (Int32.of_float (Int64.float_of_bits f))
       | "caml_nativeint_to_float", [ NativeInt i ] -> Some (float (Int32.to_float i))
@@ -284,7 +295,12 @@ let eval_prim x =
       | "caml_nativeint_of_int", [ Int i ] -> nativeint (Targetint.to_int32 i)
       (* int64 *)
       | "caml_int64_bits_of_float", [ Float f ] -> int64 f
-      | "caml_int64_float_of_bits", [ Int64 i ] -> Some (Float i)
+      | "caml_int64_float_of_bits", [ Int64 i ]
+        when match target with
+             | `JavaScript ->
+                 (not (Float.is_nan (Int64.float_of_bits i)))
+                 || Int64.equal i (Int64.bits_of_float nan)
+             | `Wasm -> true -> Some (Float i)
       | "caml_int64_of_float", [ Float f ] ->
           int64 (Int64.of_float (Int64.float_of_bits f))
       | "caml_int64_to_float", [ Int64 i ] -> Some (float (Int64.to_float i))
@@ -632,6 +648,7 @@ let eval_instr update_count inline_constant ~target info i =
             | _ -> false)
         then
           eval_prim
+            ~target
             ( prim
             , List.map prim_args' ~f:(function
                 | Some c -> c

compiler/tests-full/stdlib.cma.expected.js

@@ -8028,6 +8028,7 @@
     caml_floatarray_make = runtime.caml_floatarray_make,
     caml_floatarray_sub = runtime.caml_floatarray_sub,
     caml_hash = runtime.caml_hash,
+    caml_int64_create_lo_mi_hi = runtime.caml_int64_create_lo_mi_hi,
     caml_maybe_attach_backtrace = runtime.caml_maybe_attach_backtrace,
     caml_nextafter_float = runtime.caml_nextafter_float,
     caml_signbit_float = runtime.caml_signbit_float,
@@ -8050,7 +8051,10 @@
     Stdlib = global_data.Stdlib,
     infinity = Stdlib[22],
     neg_infinity = Stdlib[23],
-    nan = Stdlib[24];
+    nan = Stdlib[24],
+    signaling_nan =
+       /*<<float.ml:38:20>>*/ runtime.caml_int64_float_of_bits
+       (caml_int64_create_lo_mi_hi(1, 0, 32752));
    function is_finite(x){
      /*<<float.ml:39:33>>*/ return x - x === 0. ? 1 : 0;
     /*<<float.ml:39:38>>*/ }
@@ -8983,7 +8987,7 @@
        infinity,
        neg_infinity,
        nan,
-       NaN,
+       signaling_nan,
        nan,
        3.141592653589793,
        max_float,

runtime/js/ieee_754.js

@@ -27,10 +27,14 @@ function caml_int64_bits_of_float(x) {
   jsoo_dataview.setFloat64(0, x, true);
   var lo32 = jsoo_dataview.getUint32(0, true);
   var hi32 = jsoo_dataview.getUint32(4, true);
-  var r1 = lo32 & 0xffffff;
-  var r2 = (lo32 >>> 24) | ((hi32 << 8) & 0xffffff);
-  var r3 = (hi32 >>> 16) & 0xffff;
-  return caml_int64_create_lo_mi_hi(r1, r2, r3);
+  var lo = lo32 & 0xffffff;
+  var mi = (lo32 >>> 24) | ((hi32 << 8) & 0xffffff);
+  var hi = (hi32 >>> 16) & 0xffff;
+  // V8 uses signaling NaNs as sentinal. So, NaNs are made quiet when
+  // they are stored in an array. Make them quiet here so that we get
+  // consistent results.
+  if ((hi & 0x7ff8) === 0x7ff0 && (mi | lo | (hi & 0xf)) !== 0) hi |= 8;
+  return caml_int64_create_lo_mi_hi(lo, mi, hi);
 }
 
 //Provides: caml_int32_bits_of_float const
@@ -108,6 +112,10 @@ function caml_int64_float_of_bits(x) {
   var lo = x.lo;
   var mi = x.mi;
   var hi = x.hi;
+  // V8 uses signaling NaNs as sentinal. So, NaNs are made quiet when
+  // they are stored in an array. Make them quiet here so that we get
+  // consistent results.
+  if ((hi & 0x7ff8) === 0x7ff0 && (mi | lo | (hi & 0xf)) !== 0) hi |= 8;
   jsoo_dataview.setUint32(0, lo | (mi << 24), true);
   jsoo_dataview.setUint32(4, (mi >>> 8) | (hi << 16), true);
   return jsoo_dataview.getFloat64(0, true);