Compiler: preserve bit representation of NaN

Author: hhugo

compiler/lib/generate.ml

@@ -386,8 +386,6 @@ let source_location ctx position pc =
 
 (****)
 
-let float_const f = J.ENum (J.Num.of_float (Int64.float_of_bits f))
-
 let s_var name = J.EVar (J.ident (Utf8_string.of_string_exn name))
 
 let runtime_fun ctx name =
@@ -398,6 +396,20 @@ let runtime_fun ctx name =
       J.dot (J.EVar (J.V runtime)) name
   | None -> s_var name
 
+let float_const ctx bits =
+  let f = Int64.float_of_bits bits in
+  match Float.classify_float f with
+  | FP_nan ->
+      let targetint x = J.ENum (J.Num.of_string_unsafe (Targetint.to_string_16 x)) in
+      let p = Share.get_prim (runtime_fun ctx) "jsoo_float_of_bits" ctx.Ctx.share in
+      let lo = targetint (Targetint.of_int32_truncate (Int64.to_int32 bits))
+      and hi =
+        targetint
+          (Targetint.of_int32_truncate (Int64.to_int32 (Int64.shift_right bits 32)))
+      in
+      J.call p [ lo; hi ] J.N
+  | FP_zero | FP_normal | FP_subnormal | FP_infinite -> J.ENum (J.Num.of_float f)
+
 let str_js_byte s =
   let b = Buffer.create (String.length s) in
   String.iter s ~f:(function
@@ -468,11 +480,11 @@ let rec constant_rec ~ctx x level instrs =
       match s with
       | Byte x -> Share.get_byte_string str_js_byte x ctx.Ctx.share, instrs
       | Utf (Utf8 x) -> Share.get_utf_string str_js_utf8 x ctx.Ctx.share, instrs)
-  | Float f -> float_const f, instrs
+  | Float f -> float_const ctx f, instrs
   | Float_array a ->
       ( Mlvalue.Array.make
           ~tag:Obj.double_array_tag
-          ~args:(Array.to_list (Array.map a ~f:(fun x -> J.Element (float_const x))))
+          ~args:(Array.to_list (Array.map a ~f:(fun x -> J.Element (float_const ctx x))))
       , instrs )
   | Int64 i ->
       let p =

compiler/lib/targetint.ml

@@ -41,6 +41,8 @@ let max_int () =
 
 let to_string x = Int32.to_string x
 
+let to_string_16 (x : t) = Printf.sprintf "0x%lx" x
+
 let to_float x = Int32.to_float x
 
 let to_int32 x = x

compiler/lib/targetint.mli

@@ -10,6 +10,8 @@ val is_zero : t -> bool
 
 val to_string : t -> string
 
+val to_string_16 : t -> string
+
 val to_int_exn : t -> int
 
 val to_float : t -> float

compiler/tests-compiler/variable_declaration_output.ml

@@ -55,10 +55,17 @@ let%expect_test _ =
     //end
     var bx = [254, 1., 2., 3., 4.];
     //end
-    var cx = [254, NaN, NaN, Infinity, - Infinity, 0., - 0.];
+    var cx = [254,
+     runtime.jsoo_float_of_bits(0x0, 0xfff80000),
+     runtime.jsoo_float_of_bits(0x0, 0xfff80000),
+     Infinity,
+     - Infinity,
+     0.,
+     - 0.];
     //end
     var symbol_op = [0, symbol_bind, symbol_map, symbol];
-    //end |}]
+    //end
+    |}]
 
 let%expect_test _ =
   let program =
@@ -98,10 +105,17 @@ let%expect_test _ =
     //end
     var bx = [254, 1., 2., 3., 4.];
     //end
-    var cx = [254, NaN, NaN, Infinity, - Infinity, 0., - 0.];
+    var cx = [254,
+     runtime.jsoo_float_of_bits(0x0, 0xfff80000),
+     runtime.jsoo_float_of_bits(0x0, 0xfff80000),
+     Infinity,
+     - Infinity,
+     0.,
+     - 0.];
     //end
     var symbol_op = [0, symbol_bind, symbol_map, symbol];
-    //end |}]
+    //end
+    |}]
 
 let%expect_test _ =
   let compile ~enable s =

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

@@ -888,7 +888,7 @@
        lnot,
        Infinity,
        -Infinity,
-       NaN,
+       runtime.jsoo_float_of_bits(0x1, 0x7ff80000),
        1.7976931348623157e+308,
        2.2250738585072014e-308,
        2.220446049250313e-16,
@@ -9008,7 +9008,7 @@
        infinity,
        neg_infinity,
        nan,
-       NaN,
+       runtime.jsoo_float_of_bits(0x1, 0x7ff00000),
        nan,
        3.141592653589793,
        max_float,

runtime/js/ieee_754.js

@@ -113,6 +113,14 @@ function caml_int64_float_of_bits(x) {
   return jsoo_dataview.getFloat64(0, true);
 }
 
+//Provides: jsoo_float_of_bits const
+//Requires: jsoo_dataview
+function jsoo_float_of_bits(l, h) {
+  jsoo_dataview.setUint32(0, l, true);
+  jsoo_dataview.setUint32(4, h, true);
+  return jsoo_dataview.getFloat64(0, true);
+}
+
 //Provides: caml_nextafter_float const
 //Requires: caml_int64_float_of_bits, caml_int64_bits_of_float, caml_int64_add, caml_int64_sub,caml_int64_of_int32
 function caml_nextafter_float(x, y) {