part1: add hex float notation support and basic tests around pervasives.ml constant

Author: bobzhang

jscomp/core/js_dump.ml

@@ -631,11 +631,11 @@ and expression_desc cxt (level:int) f x : cxt  =
   | Number v ->
     let s =
       match v with
-      | Float {f = v} ->
-        Js_number.caml_float_literal_to_js_string v
+      | Float {f} ->
+        Js_number.caml_float_literal_to_js_string f
       (* attach string here for float constant folding?*)
-      | Int { i = v; _}
-        -> Int32.to_string v (* check , js convention with ocaml lexical convention *)
+      | Int { i; _}
+        -> Int32.to_string i (* check , js convention with ocaml lexical convention *)
       | Uint i
         -> Format.asprintf "%lu" i
       | Nint i -> Nativeint.to_string i in
@@ -645,7 +645,8 @@ and expression_desc cxt (level:int) f x : cxt  =
       else level = 15  (* Parenthesize as well when followed by a dot. *)
            && s.[0] <> 'I' (* Infinity *)
            && s.[0] <> 'N' (* NaN *) in
-    let action = fun _ -> P.string f s  in
+    let action = 
+      fun _ -> P.string f s  in
     (
       if need_paren
       then P.paren f  action

jscomp/core/js_number.ml

@@ -72,17 +72,22 @@ let to_string v =
         else  Printf.sprintf "%.18g" v
 
 
+let rec is_hex_format_aux (v : string) cur = 
+    if v.[cur] = '-' || v.[cur]= '+' then 
+      is_hex_format_ox v (cur + 1)
+    else is_hex_format_ox v cur 
+and is_hex_format_ox v cur = 
+  v.[cur] = '0' && 
+  (v.[cur + 1] = 'x' || v.[cur + 1] = 'X')
 
-let caml_float_literal_to_js_string v = 
+let is_hex_format (v : string) =   
+  try is_hex_format_aux v 0 with _ -> false
+
+
+let caml_float_literal_to_js_string (v : string) : string = 
   let len = String.length v in
-  if len >= 2 && 
-    v.[0] = '0' &&
-    (v.[1] = 'x' || v.[1] = 'X') then  
-    assert false 
-   (* TODO: catchup when upgraded to 4.3 
-      it does not make sense too much since js dos not 
-      support it natively
-    *)    
+  if len >= 2 && is_hex_format v then  
+    to_string (float_of_string v)
   else    
 
     let rec aux buf i = 

jscomp/core/js_number.mli

@@ -31,7 +31,7 @@
 type t  = float 
 
 
-val to_string : t -> string
+(* val to_string : t -> string *)
 
 
 val caml_float_literal_to_js_string : string -> string

jscomp/stdlib-406/pervasives.ml

@@ -201,19 +201,13 @@ external float_of_bits : int64 -> float
   [@@unboxed] [@@noalloc]
 #end
 #if BS then 
-external infinity : float = "POSITIVE_INFINITY" 
-[@@bs.val]  [@@bs.scope "Number"]
-external neg_infinity : float = "NEGATIVE_INFINITY"
-[@@bs.val]  [@@bs.scope "Number"]
+let infinity = 0x1p2047
+let neg_infinity = -0x1p2047
 external nan : float = "NaN"
 [@@bs.val]  [@@bs.scope "Number"]
-external max_float : float = "MAX_VALUE"
-[@@bs.val]  [@@bs.scope "Number"]
-external min_float : float = "MIN_VALUE"
-[@@bs.val]  [@@bs.scope "Number"]
-(* external epsilon_float : float = "EPSILON" (* ES 2015 *)
-[@@bs.val]  [@@bs.scope "Number"]   *)
-let epsilon_float = 2.220446049250313e-16
+let max_float = 0x1.ffff_ffff_ffff_fp+1023
+let min_float = 0x1p-1022
+let epsilon_float = 0x1p-52
 #else  
 let infinity =
   float_of_bits 0x7F_F0_00_00_00_00_00_00L

jscomp/stdlib-406/pervasives.mli

@@ -614,29 +614,18 @@ external int_of_float : float -> int = "%intoffloat"
    The result is unspecified if the argument is [nan] or falls outside the
    range of representable integers. *)
 
-#if BS then 
-external infinity : float = "POSITIVE_INFINITY" 
-[@@bs.val]  [@@bs.scope "Number"]
-external neg_infinity : float = "NEGATIVE_INFINITY"
-[@@bs.val]  [@@bs.scope "Number"]
-external nan : float = "NaN"
-[@@bs.val]  [@@bs.scope "Number"]
-external max_float : float = "MAX_VALUE"
-[@@bs.val]  [@@bs.scope "Number"]
-external min_float : float = "MIN_VALUE"
-[@@bs.val]  [@@bs.scope "Number"]
-(* external epsilon_float : float = "EPSILON" (* ES 2015 *)
-[@@bs.val]  [@@bs.scope "Number"]   *)
-val epsilon_float : float
-#else
-
 val infinity : float
 (** Positive infinity. *)
 
 val neg_infinity : float
 (** Negative infinity. *)
 
+#if BS then
+external nan : float = "NaN" [@@bs.val]  [@@bs.scope "Number"]
+(* we could also use [0.  /. 0.] *)
+#else
 val nan : float
+#end
 (** A special floating-point value denoting the result of an
    undefined operation such as [0.0 /. 0.0].  Stands for
    'not a number'.  Any floating-point operation with [nan] as
@@ -653,7 +642,7 @@ val min_float : float
 val epsilon_float : float
 (** The difference between [1.0] and the smallest exactly representable
     floating-point number greater than [1.0]. *)
-#end
+
 
 type fpclass =
     FP_normal           (** Normal number, none of the below *)

jscomp/test/format_test.ml

@@ -5,10 +5,81 @@ let eq loc x y =
   suites := 
     (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites
 
+let eq3 loc a b c = 
+  eq loc a b ; 
+  eq loc b c ; 
+  eq loc a c 
 
 let u () = "xx %s" ^^ "yy"
 
+module M = struct 
+  external infinity : float = "POSITIVE_INFINITY" 
+  [@@bs.val]  [@@bs.scope "Number"]
+  external neg_infinity : float = "NEGATIVE_INFINITY"
+  [@@bs.val]  [@@bs.scope "Number"]
+  external nan : float = "NaN"
+  [@@bs.val]  [@@bs.scope "Number"]
+  external max_float : float = "MAX_VALUE"
+  [@@bs.val]  [@@bs.scope "Number"]
+end 
 let () = 
   eq __LOC__ (Format.asprintf (u ()) "x") ("xx x" ^ "yy")
+  
 
+#if OCAML_VERSION =~ ">4.03.0" then
+let () = 
+  eq __LOC__ (0x3.fp+1) (7.875);
+
+
+  eq __LOC__ (-0x3.fp+1) (-7.875);  
+  (* in standard, it is still infinity, but 
+    ideally should give an warning
+  *)
+  eq3 __LOC__ 0x1p2047 M.infinity infinity;
+  eq3 __LOC__ (-0x1p2047) M.neg_infinity neg_infinity;  
+  eq3 __LOC__ max_float 0x1.ffff_ffff_ffff_fp+1023 M.max_float;  
+  eq __LOC__ (classify_float 0x1.2p2047) FP_infinite;
+  eq __LOC__ (classify_float 0x1.1p2047) FP_infinite;
+  
+  
+  eq __LOC__ min_float 0x1p-1022;
+  eq __LOC__ epsilon_float 0x1p-52;
+  eq __LOC__ 0x0.0000_0000_0000_1p-1022 5e-324;
+  eq __LOC__  
+    (0x1.0000_0000_0000_1 -. 1.) epsilon_float;
+  eq __LOC__
+    (0x1p-1023 /. 0x1p-1022) 0x1p-1;
+  eq __LOC__ (classify_float 0x1p-1023) FP_subnormal;
+  eq __LOC__  
+    0x1p-1023 0x0.8p-1022;
+  eq __LOC__  
+    0x0.ffff_ffff_ffff_ffff_ffp-1022
+    0x1p-1022;
+
+  eq __LOC__  
+    ((1. +. 0xffp0 /. 0x100p0 ) *. 8.)
+    (0x1.ffp3);
+  eq __LOC__  
+    ((1. +. 0xfffp0 /. 0x1000p0) *. 8.)
+    0x1.fffp3;
+  eq __LOC__  
+    ((1. +. 0xffffp0 /. 0x10000p0) *. 8.)
+    0x1.ffffp3    
+  ;;
+#end  
+(*TODO: add scanf example *)
+#if 
+  (* OCAML_VERSION =~ ">4.03.0" *) 0
+then
+
+
+let () = 
+     eq __LOC__ (float_of_string "0x3.fp+1")  0x3.fp+1;;
+
+let () = eq __LOC__ (Printf.sprintf "%h" 0x3.fp+1) "0x1.f8p+2"
+let () = eq __LOC__ (Printf.sprintf "%H" 0x3.fp+1) "0x1.F8P+2"
+
+let () = eq __LOC__ (Printf.sprintf "%h" 0.3) "0x1.3333333333333p-2"
+
+#end
 let () = Mt.from_pair_suites __FILE__ !suites