Merge pull request #3156 from BuckleScript/hex_float

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,19 +72,25 @@ 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 OCAML_VERSION =~ ">4.03.0"  then
+  if len >= 2 && is_hex_format v then  
+    to_string (float_of_string v)
   else    
-
+#end
     let rec aux buf i = 
       if i >= len then buf
       else 

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/runtime/caml_format.ml

@@ -570,7 +570,6 @@ let caml_format_float fmt x =
     end;
   finish_formatting f !s
 
-
 (**
  external float_of_string : string -> float = "caml_float_of_string"
  pervasives.ml
@@ -584,35 +583,55 @@ let caml_format_float fmt x =
  FIXME: arity of float_of_string is not inferred correctly
 *)
 
-let float_of_string : string -> (string -> 'a) ->  float = [%bs.raw {|
-  function (s, caml_failwith) {
+let float_of_string : string -> exn ->  float  = 
+#if OCAML_VERSION =~ ">4.3.0" then
+    fun%raw s exn -> {| 
+   {
     var res = +s;
     if ((s.length > 0) && (res === res))
         return res;
     s = s.replace(/_/g, "");
     res = +s;
     if (((s.length > 0) && (res === res)) || /^[+-]?nan$/i.test(s)) {
         return res;
-    }
-    ;
-    if (/^ *0x[0-9a-f_]+p[+-]?[0-9_]+/i.test(s)) {
-        var pidx = s.indexOf('p');
-        pidx = (pidx == -1) ? s.indexOf('P') : pidx;
-        var exp = +s.substring(pidx + 1);
-        res = +s.substring(0, pidx);
-        return res * Math.pow(2, exp);
+    };
+    var m = /^ *([+-]?)0x([0-9a-f]+)\.?([0-9a-f]*)p([+-]?[0-9]+)/i.exec(s);
+    //            1        2             3           4
+    if(m){
+        var m3 = m[3].replace(/0+$/,'');
+        var mantissa = parseInt(m[1] + m[2] + m3, 16);
+        var exponent = (m[4]|0) - 4*m3.length;
+        res = mantissa * Math.pow(2, exponent);
+        return res;
     }
     if (/^\+?inf(inity)?$/i.test(s))
         return Infinity;
     if (/^-inf(inity)?$/i.test(s))
         return -Infinity;
-    caml_failwith("float_of_string");
+    throw exn;
+}
+|}
+#else
+    fun%raw s exn -> {| 
+   {
+    var res = +s;
+    if ((s.length > 0) && (res === res))
+        return res;
+    s = s.replace(/_/g, "");
+    res = +s;
+    if (((s.length > 0) && (res === res)) || /^[+-]?nan$/i.test(s)) {
+        return res;
+    };
+    if (/^\+?inf(inity)?$/i.test(s))
+        return Infinity;
+    if (/^-inf(inity)?$/i.test(s))
+        return -Infinity;
+    throw exn;
 }
-
 |}
-]
+#end
 
-let caml_float_of_string s = float_of_string s caml_failwith
+let caml_float_of_string s = float_of_string s (Failure "float_of_string") 
 
 let caml_nativeint_format = caml_format_int
 let caml_int32_format = caml_format_int

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,96 @@ 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 *)
+
+let f loc ls  = 
+  List.iter  (fun (a,b) -> 
+  eq loc (float_of_string a) b ) ls
+
+#if OCAML_VERSION=~ ">4.03.0" then
+let () = 
+    f __LOC__ [
+      "0x3.fp+1",  0x3.fp+1 ;
+      " 0x3.fp2", 0x3.fp2;
+      " 0x4.fp2", 0x4.fp2
+      ];
+    
+#end     
+;;
+
+#if 
+  (* OCAML_VERSION =~ ">4.03.0" *) 0
+then
+
+
+
+
+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

lib/js/caml_format.js

@@ -1,18 +1,10 @@
 'use strict';
 
-var Curry = require("./curry.js");
 var Caml_int32 = require("./caml_int32.js");
 var Caml_int64 = require("./caml_int64.js");
 var Caml_utils = require("./caml_utils.js");
 var Caml_builtin_exceptions = require("./caml_builtin_exceptions.js");
 
-function caml_failwith(s) {
-  throw [
-        Caml_builtin_exceptions.failure,
-        s
-      ];
-}
-
 function parse_digit(c) {
   if (c >= 65) {
     if (c >= 97) {
@@ -778,8 +770,8 @@ function caml_format_float(fmt, x) {
   return finish_formatting(f, s);
 }
 
-var float_of_string = (
-  function (s, caml_failwith) {
+var float_of_string = function (s,exn){ 
+   {
     var res = +s;
     if ((s.length > 0) && (res === res))
         return res;
@@ -800,13 +792,16 @@ var float_of_string = (
         return Infinity;
     if (/^-inf(inity)?$/i.test(s))
         return -Infinity;
-    caml_failwith("float_of_string");
+    throw exn;
 }
 
-);
+};
 
 function caml_float_of_string(s) {
-  return Curry._2(float_of_string, s, caml_failwith);
+  return float_of_string(s, [
+              Caml_builtin_exceptions.failure,
+              "float_of_string"
+            ]);
 }
 
 var caml_nativeint_format = caml_format_int;
@@ -827,4 +822,4 @@ exports.caml_int_of_string = caml_int_of_string;
 exports.caml_int32_of_string = caml_int32_of_string;
 exports.caml_int64_of_string = caml_int64_of_string;
 exports.caml_nativeint_of_string = caml_nativeint_of_string;
-/* float_of_string Not a pure module */
+/* Caml_utils Not a pure module */