Compiler: abstract javascript numbers

compiler/lib/generate.ml

@@ -224,9 +224,9 @@ end
 
 let var x = J.EVar (J.V x)
 
-let int n = J.ENum (string_of_int n)
+let int n = J.ENum (J.Num.of_int32 (Int32.of_int n))
 
-let int32 n = J.ENum (Int32.to_string n)
+let int32 n = J.ENum (J.Num.of_int32 n)
 
 let unsigned x = J.EBin (J.Lsr, x, int 0)
 
@@ -236,8 +236,9 @@ let zero = int 0
 
 let plus_int x y =
   match x, y with
-  | J.ENum "0", x | x, J.ENum "0" -> x
-  | J.ENum x, J.ENum y -> J.ENum Int32.(to_string (add (of_string x) (of_string y)))
+  | J.ENum y, x when J.Num.is_zero y -> x
+  | x, J.ENum y when J.Num.is_zero y -> x
+  | J.ENum x, J.ENum y -> J.ENum (J.Num.add x y)
   | x, y -> J.EBin (J.Plus, x, y)
 
 let bool e = J.ECond (e, one, zero)
@@ -248,8 +249,6 @@ let val_float f = f
 (*J.EArr [Some (J.ENum 253.); Some f]*)
 let float_val e = e
 
-(*J.EAccess (e, one)*)
-
 (****)
 
 let source_location ctx ?after pc =
@@ -259,7 +258,7 @@ let source_location ctx ?after pc =
 
 (****)
 
-let float_const f = val_float (J.ENum (Javascript.string_of_float f))
+let float_const f = val_float (J.ENum (J.Num.of_float f))
 
 let s_var name = J.EVar (J.S {J.name; J.var = None})
 
@@ -1114,13 +1113,10 @@ let rec translate_expr ctx queue loc _x e level : _ * J.statement_list =
             let i, queue =
               let (_px, cx), queue = access_queue' ~ctx queue size in
               match cx with
-              | J.ENum i -> Int32.of_string i, queue
+              | J.ENum i -> Int32.to_int (J.Num.to_int32 i), queue
               | _ -> assert false
             in
-            let args =
-              Array.to_list
-                (Array.init (Int32.to_int i) ~f:(fun _ -> J.V (Var.fresh ())))
-            in
+            let args = Array.to_list (Array.init i ~f:(fun _ -> J.V (Var.fresh ()))) in
             let f = J.V (Var.fresh ()) in
             let call =
               J.ECall

compiler/lib/javascript.ml

@@ -19,6 +19,87 @@
  *)
 open Stdlib
 
+module Num : sig
+  type t
+
+  (** Conversions *)
+
+  val of_string_unsafe : string -> t
+
+  val of_int32 : int32 -> t
+
+  val of_float : float -> t
+
+  val to_string : t -> string
+
+  val to_int32 : t -> int32
+
+  (** Predicates *)
+
+  val is_zero : t -> bool
+
+  val is_one : t -> bool
+
+  val is_neg : t -> bool
+
+  (** Arithmetic *)
+
+  val add : t -> t -> t
+
+  val neg : t -> t
+end = struct
+  type t = string
+
+  let of_string_unsafe s = s
+
+  let to_string s = s
+
+  let to_int32 s =
+    if String.is_prefix s ~prefix:"0"
+       && String.length s > 1
+       && String.for_all s ~f:(function
+              | '0' .. '7' -> true
+              | _ -> false)
+    then (* octal notation *)
+      Int32.of_string ("0o" ^ s)
+    else Int32.of_string s
+
+  let of_int32 = Int32.to_string
+
+  let of_float v =
+    if v = infinity
+    then "Infinity"
+    else if v = neg_infinity
+    then "-Infinity"
+    else if v <> v
+    then "NaN" (* [1/-0] = -inf seems to be the only way to detect -0 in JavaScript *)
+    else if v = 0. && 1. /. v = neg_infinity
+    then "-0."
+    else
+      let vint = int_of_float v in
+      if float_of_int vint = v
+      then Printf.sprintf "%d." vint
+      else
+        let s1 = Printf.sprintf "%.12g" v in
+        if v = float_of_string s1
+        then s1
+        else
+          let s2 = Printf.sprintf "%.15g" v in
+          if v = float_of_string s2 then s2 else Printf.sprintf "%.18g" v
+
+  let is_zero s = String.equal s "0"
+
+  let is_one s = String.equal s "1"
+
+  let is_neg s = s.[0] = '-'
+
+  let drop1 s = String.sub s ~pos:1 ~len:(String.length s - 1)
+
+  let neg s = if is_neg s then drop1 s else "-" ^ s
+
+  let add a b = of_int32 (Int32.add (to_int32 a) (to_int32 b))
+end
+
 module Label = struct
   type t =
     | L of int
@@ -116,7 +197,7 @@ and property_name_and_value_list = (property_name * expression) list
 and property_name =
   | PNI of identifier
   | PNS of string
-  | PNN of string
+  | PNN of Num.t
 
 and expression =
   | ESeq of expression * expression
@@ -132,7 +213,7 @@ and expression =
   | EStr of string * [`Bytes | `Utf8]
   | EArr of array_litteral
   | EBool of bool
-  | ENum of string
+  | ENum of Num.t
   | EObj of property_name_and_value_list
   | EQuote of string
   | ERegexp of string * string option
@@ -214,28 +295,6 @@ let compare_ident t1 t2 =
   | S _, V _ -> -1
   | V _, S _ -> 1
 
-let string_of_float v =
-  if v = infinity
-  then "Infinity"
-  else if v = neg_infinity
-  then "-Infinity"
-  else if v <> v
-  then "NaN" (* [1/-0] = -inf seems to be the only way to detect -0 in JavaScript *)
-  else if v = 0. && 1. /. v = neg_infinity
-  then "-0."
-  else
-    let vint = int_of_float v in
-    (* compiler 1000 into 1e3 *)
-    if float_of_int vint = v
-    then Printf.sprintf "%d." vint
-    else
-      let s1 = Printf.sprintf "%.12g" v in
-      if v = float_of_string s1
-      then s1
-      else
-        let s2 = Printf.sprintf "%.15g" v in
-        if v = float_of_string s2 then s2 else Printf.sprintf "%.18g" v
-
 exception Not_an_ident
 
 let is_ident =

compiler/lib/javascript.mli

@@ -17,6 +17,37 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
+
+module Num : sig
+  type t
+
+  (** Conversions *)
+
+  val of_string_unsafe : string -> t
+
+  val of_int32 : int32 -> t
+
+  val of_float : float -> t
+
+  val to_string : t -> string
+
+  val to_int32 : t -> int32
+
+  (** Predicates *)
+
+  val is_zero : t -> bool
+
+  val is_one : t -> bool
+
+  val is_neg : t -> bool
+
+  (** Arithmetic *)
+
+  val add : t -> t -> t
+
+  val neg : t -> t
+end
+
 module Label : sig
   type t
 
@@ -110,7 +141,7 @@ and property_name_and_value_list = (property_name * expression) list
 and property_name =
   | PNI of identifier
   | PNS of string
-  | PNN of string
+  | PNN of Num.t
 
 and expression =
   | ESeq of expression * expression
@@ -129,7 +160,7 @@ and expression =
          escape sequences. *)
   | EArr of array_litteral
   | EBool of bool
-  | ENum of string
+  | ENum of Num.t
   | EObj of property_name_and_value_list
   | EQuote of string
   | ERegexp of string * string option
@@ -200,8 +231,6 @@ and source_element =
 
 val compare_ident : ident -> ident -> int
 
-val string_of_float : float -> string
-
 val is_ident : string -> bool
 
 module IdentSet : Set.S with type elt = ident

compiler/lib/js_output.ml

@@ -378,6 +378,7 @@ struct
         pp_string f ~utf:(kind = `Utf8) ~quote s
     | EBool b -> PP.string f (if b then "true" else "false")
     | ENum s ->
+        let s = Num.to_string s in
         let need_parent =
           if s.[0] = '-'
           then l > 13 (* Negative numbers may need to be parenthesized. *)

compiler/lib/js_parser.ml

@@ -23961,7 +23961,7 @@ and _menhir_run10 : _menhir_env -> 'ttv_tail -> _menhir_state -> (
         let ((_1 : 'tv_numeric_literal) : 'tv_numeric_literal) = _v in
         ((let _v : 'tv_primary_expression_no_statement = 
 # 418 "js_parser.mly"
-                     ( let (start, n) = _1 in (start, J.ENum n) )
+                     ( let (start, n) = _1 in (start, J.ENum (J.Num.of_string_unsafe n)) )
 # 23966 "js_parser.ml"
          in
         _menhir_goto_primary_expression_no_statement _menhir_env _menhir_stack _menhir_s _v) : 'freshtv40)) : 'freshtv42)
@@ -23976,7 +23976,7 @@ and _menhir_run10 : _menhir_env -> 'ttv_tail -> _menhir_state -> (
         let ((n : 'tv_numeric_literal) : 'tv_numeric_literal) = _v in
         ((let _v : 'tv_property_name = 
 # 638 "js_parser.mly"
-                      ( J.PNN (snd n) )
+                      ( J.PNN (J.Num.of_string_unsafe (snd n)) )
 # 23981 "js_parser.ml"
          in
         _menhir_goto_property_name _menhir_env _menhir_stack _menhir_s _v) : 'freshtv44)) : 'freshtv46)

compiler/lib/js_parser.mly

@@ -415,7 +415,7 @@ primary_expression_no_statement:
  | variable_with_loc { let (i, pi) = $1 in (pi, J.EVar (var i)) }
  | n=null_literal    { n }
  | b=boolean_literal { b }
- | numeric_literal   { let (start, n) = $1 in (start, J.ENum n) }
+ | numeric_literal   { let (start, n) = $1 in (start, J.ENum (J.Num.of_string_unsafe n)) }
  | T_STRING          { let (s, start) = $1 in (start, J.EStr (s, `Utf8)) }
    (* marcel: this isn't an expansion of literal in ECMA-262... mistake? *)
  | r=regex_literal                { r }
@@ -635,7 +635,7 @@ label:
 property_name:
  | i=identifier_or_kw { J.PNI i }
  | s=T_STRING         { J.PNS (fst s) }
- | n=numeric_literal  { J.PNN (snd n) }
+ | n=numeric_literal  { J.PNN (J.Num.of_string_unsafe (snd n)) }
 
 (*************************************************************************)
 (* 1 xxx_opt, xxx_list                                                   *)

compiler/lib/js_simpl.ml

@@ -108,8 +108,9 @@ let assignment_of_statement st =
 
 let simplify_condition = function
   (* | J.ECond _  -> J.ENum 1. *)
-  | J.ECond (e, J.ENum "1", J.ENum "0") -> e
-  | J.ECond (e, J.ENum "0", J.ENum "1") -> J.EUn (J.Not, e)
+  | J.ECond (e, J.ENum one, J.ENum zero) when J.Num.is_one one && J.Num.is_zero zero -> e
+  | J.ECond (e, J.ENum zero, J.ENum one) when J.Num.is_one one && J.Num.is_zero zero ->
+      J.EUn (J.Not, e)
   | J.ECond (J.EBin ((J.NotEqEq | J.NotEq), J.ENum n, y), e1, e2)
    |J.ECond (J.EBin ((J.NotEqEq | J.NotEq), y, J.ENum n), e1, e2) ->
       J.ECond (J.EBin (J.Band, y, J.ENum n), e1, e2)

compiler/lib/js_traverse.ml

@@ -258,6 +258,7 @@ class share_constant =
                 then Some ("str_" ^ s)
                 else Some ("str_" ^ String.sub s ~pos:0 ~len:16 ^ "_abr")
             | ENum s when n > 1 ->
+                let s = Javascript.Num.to_string s in
                 let l = String.length s in
                 if l > 2 then Some ("num_" ^ s) else None
             | _ -> None
@@ -804,7 +805,7 @@ let translate_assign_op = function
   | _ -> assert false
 
 let is_one = function
-  | ENum "1" -> true
+  | ENum n -> Num.is_one n
   | _ -> false
 
 let assign_op = function
@@ -817,7 +818,7 @@ let assign_op = function
         else Some (EBin (PlusEq, exp, exp''))
     | false, true ->
         if is_one exp' then Some (EUn (IncrB, exp)) else Some (EBin (PlusEq, exp, exp'))
-    | true, true -> Some (EBin (StarEq, exp, ENum "2")))
+    | true, true -> Some (EBin (StarEq, exp, ENum (Num.of_int32 2l))))
   | exp, EBin (Minus, exp', y) when exp = exp' ->
       if is_one y then Some (EUn (DecrB, exp)) else Some (EBin (MinusEq, exp, y))
   | exp, EBin (Mul, exp', exp'') -> (
@@ -835,20 +836,24 @@ class simpl =
     inherit map as super
 
     method expression e =
-      let drop1 s = String.sub s ~pos:1 ~len:(String.length s - 1) in
       let e = super#expression e in
+      let is_zero x =
+        match Num.to_string x with
+        | "0" | "0." -> true
+        | _ -> false
+      in
       match e with
       | EBin (Plus, e1, e2) -> (
         match e2, e1 with
-        | ENum n, _ when n.[0] = '-' -> EBin (Minus, e1, ENum (drop1 n))
-        | _, ENum n when n.[0] = '-' -> EBin (Minus, e2, ENum (drop1 n))
-        | ENum ("0" | "0."), (ENum _ as x) -> x
-        | (ENum _ as x), ENum ("0" | "0.") -> x
+        | ENum n, _ when Num.is_neg n -> EBin (Minus, e1, ENum (Num.neg n))
+        | _, ENum n when Num.is_neg n -> EBin (Minus, e2, ENum (Num.neg n))
+        | ENum zero, (ENum _ as x) when is_zero zero -> x
+        | (ENum _ as x), ENum zero when is_zero zero -> x
         | _ -> e)
       | EBin (Minus, e1, e2) -> (
         match e2, e1 with
-        | ENum n, _ when n.[0] = '-' -> EBin (Plus, e1, ENum (drop1 n))
-        | (ENum _ as x), ENum ("0" | "0.") -> x
+        | ENum n, _ when Num.is_neg n -> EBin (Plus, e1, ENum (Num.neg n))
+        | (ENum _ as x), ENum zero when is_zero zero -> x
         | _ -> e)
       | _ -> e