add primitive bigint

Author: mununki

jscomp/core/js_analyzer.ml

@@ -158,6 +158,8 @@ let rec eq_expression ({ expression_desc = x0 } : J.expression)
   | Undefined x -> y0 = Undefined x
   | Number (Int { i }) -> (
       match y0 with Number (Int { i = j }) -> i = j | _ -> false)
+  | Number (Bigint { i }) -> (
+    match y0 with Number (Bigint { i = j }) -> i = j | _ -> false)
   | Number (Float _) -> false
   (* begin match y0 with
      | Number (Float j) ->

jscomp/core/js_dump.ml

@@ -664,6 +664,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
             Int32.to_string i
             (* check , js convention with ocaml lexical convention *)
         | Uint i -> Format.asprintf "%lu" i
+        | Bigint { i } -> Format.asprintf "%sn" i
       in
       let need_paren =
         if s.[0] = '-' then level > 13

jscomp/core/js_exp_make.ml

@@ -312,6 +312,10 @@ let obj_int_tag_literal : t =
 
 let int ?comment ?c i : t = { expression_desc = Number (Int { i; c }); comment }
 
+let bigint ?comment i : t = { expression_desc = Number (Bigint { i }); comment}
+
+let zero_bigint_literal : t = {expression_desc = Number (Bigint {i = "0"}); comment = None}
+
 let small_int i : t =
   match i with
   | 0 -> zero_int_literal
@@ -1253,6 +1257,16 @@ let rec int32_band ?comment (e1 : J.expression) (e2 : J.expression) :
 (* let int32_bin ?comment op e1 e2 : J.expression =  *)
 (*   {expression_desc = Int32_bin(op,e1, e2); comment} *)
 
+let bigint_add ?comment (e1: t) (e2:t) = bin ?comment Plus e1 e2
+
+let bigint_minus ?comment (e1: t) (e2: t) = bin ?comment Minus e1 e2
+
+let bigint_mul ?comment (e1: t) (e2: t) = bin ?comment Mul e1 e2
+
+let bigint_div ?comment (e1: t) (e2: t) = bin ?comment Div e1 e2
+
+let bigint_mod ?comment (e1: t) (e2: t) = bin ?comment Mod e1 e2
+
 (* TODO -- alpha conversion
     remember to add parens..
 *)

jscomp/core/js_exp_make.mli

@@ -111,6 +111,8 @@ val uint32 : ?comment:string -> int32 -> t
 
 val small_int : int -> t
 
+val bigint : ?comment:string -> string -> t
+
 val float : ?comment:string -> string -> t
 
 (* val empty_string_literal : t  *)
@@ -121,6 +123,8 @@ val zero_int_literal : t
 val zero_float_lit : t
 (* val obj_int_tag_literal : t *)
 
+val zero_bigint_literal : t
+
 val is_out : ?comment:string -> t -> t -> t
 (** [is_out e range] is equivalent to [e > range or e <0]
 
@@ -272,6 +276,16 @@ val string_comp : Js_op.binop -> ?comment:string -> t -> t -> t
 
 val float_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
 
+val bigint_add : ?comment: string -> t -> t -> t
+
+val bigint_minus : ?comment: string -> t-> t -> t
+
+val bigint_mul : ?comment: string -> t -> t -> t
+
+val bigint_div : ?comment: string -> t -> t -> t
+
+val bigint_mod : ?comment: string -> t -> t -> t
+
 val js_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
 
 val not : t -> t

jscomp/core/js_op.ml

@@ -125,10 +125,13 @@ type 'a access = Getter | Setter
 (* literal char *)
 type float_lit = { f : string } [@@unboxed]
 
+type bigint_lit = { i: string } [@@unboxed]
+
 type number =
   | Float of float_lit
   | Int of { i : int32; c : int option }
   | Uint of int32
+  | Bigint of bigint_lit
 
 (* becareful when constant folding +/-,
    since we treat it as js nativeint, bitwise operators:

jscomp/core/lam.ml

@@ -641,7 +641,7 @@ let rec eval_const_as_bool (v : Lam_constant.t) : bool =
   | Const_int64 x -> x <> 0L
   | Const_js_false | Const_js_null | Const_module_alias | Const_js_undefined _ ->
       false
-  | Const_js_true | Const_string _ | Const_pointer _ | Const_float _
+  | Const_js_true | Const_string _ | Const_pointer _ | Const_float _ | Const_bigint _
   | Const_block _ | Const_float_array _ ->
       true
   | Const_some b -> eval_const_as_bool b

jscomp/core/lam_analysis.ml

@@ -27,6 +27,7 @@ let not_zero_constant (x : Lam_constant.t) =
   match x with
   | Const_int { i } -> i <> 0l
   | Const_int64 i -> i <> 0L
+  | Const_bigint i -> i <> "0"
   | _ -> false
 
 let rec no_side_effects (lam : Lam.t) : bool =
@@ -53,7 +54,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
               _ ) ->
               true
           | _, _ -> false)
-      | Pmodint | Pdivint | Pdivint64 | Pmodint64 -> (
+      | Pmodint | Pdivint | Pdivint64 | Pmodint64 | Pdivbigint | Pmodbigint -> (
           match args with
           | [ _; Lconst cst ] -> not_zero_constant cst
           | _ -> false)
@@ -76,6 +77,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
       | Pintoffloat | Pfloatofint | Pnegfloat
       (* | Pabsfloat *)
       | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat | Pfloatcomp _ | Pjscomp _
+      | Pnegbigint | Paddbigint | Psubbigint | Pmulbigint
       (* String operations *)
       | Pstringlength | Pstringrefu | Pstringrefs | Pbyteslength | Pbytesrefu
       | Pbytesrefs | Pmakearray | Parraylength | Parrayrefu | Parrayrefs
@@ -193,7 +195,7 @@ let rec size (lam : Lam.t) =
 
 and size_constant x =
   match x with
-  | Const_int _ | Const_char _ | Const_float _ | Const_int64 _ | Const_pointer _
+  | Const_int _ | Const_char _ | Const_float _ | Const_int64 _ | Const_bigint _ | Const_pointer _
   | Const_js_null | Const_js_undefined _ | Const_module_alias | Const_js_true
   | Const_js_false ->
       1

jscomp/core/lam_compat.ml

@@ -22,11 +22,11 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type boxed_integer = Lambda.boxed_integer = Pnativeint | Pint32 | Pint64
+type boxed_integer = Lambda.boxed_integer = Pbigint | Pint32 | Pint64
 
 let eq_boxed_integer (p : boxed_integer) (p1 : boxed_integer) =
   match p with
-  | Pnativeint -> p1 = Pnativeint
+  | Pbigint -> p1 = Pbigint
   | Pint32 -> p1 = Pint32
   | Pint64 -> p1 = Pint64
 
@@ -59,15 +59,6 @@ let cmp_int64 (cmp : comparison) (a : int64) b : bool =
   | Clt -> a < b
   | Cge -> a >= b
 
-let cmp_nativeint (cmp : comparison) (a : nativeint) b : bool =
-  match cmp with
-  | Ceq -> a = b
-  | Cneq -> a <> b
-  | Cgt -> a > b
-  | Cle -> a <= b
-  | Clt -> a < b
-  | Cge -> a >= b
-
 let cmp_float (cmp : comparison) (a : float) b : bool =
   match cmp with
   | Ceq -> a = b

jscomp/core/lam_compat.mli

@@ -22,7 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type boxed_integer = Lambda.boxed_integer = Pnativeint | Pint32 | Pint64
+type boxed_integer = Lambda.boxed_integer = Pbigint | Pint32 | Pint64
 
 type comparison = Lambda.comparison = Ceq | Cneq | Clt | Cgt | Cle | Cge
 
@@ -59,8 +59,6 @@ val cmp_int32 : comparison -> int32 -> int32 -> bool
 
 val cmp_int64 : comparison -> int64 -> int64 -> bool
 
-val cmp_nativeint : comparison -> nativeint -> nativeint -> bool
-
 val cmp_float : comparison -> float -> float -> bool
 
 val cmp_int : comparison -> int -> int -> bool

jscomp/core/lam_compile_const.ml

@@ -74,6 +74,7 @@ and translate (x : Lam_constant.t) : J.expression =
       (* E.float (Int64.to_string i) *)
       Js_long.of_const i
       (* https://github.com/google/closure-library/blob/master/closure%2Fgoog%2Fmath%2Flong.js *)
+  | Const_bigint i -> E.bigint i
   | Const_float f -> E.float f (* TODO: preserve float *)
   | Const_string { s; unicode = false } -> E.str s
   | Const_string { s; unicode = true } -> E.str ~delim:DStarJ s

jscomp/core/lam_compile_primitive.ml

@@ -183,35 +183,44 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
       E.int32_minus E.zero_int_literal (Ext_list.singleton_exn args)
   | Pnegint64 -> Js_long.neg args
   | Pnegfloat -> E.float_minus E.zero_float_lit (Ext_list.singleton_exn args)
+  | Pnegbigint -> E.bigint_minus E.zero_bigint_literal (Ext_list.singleton_exn args)
   (* Negate boxed int end*)
   (* Int addition and subtraction *)
   | Paddint -> (
       match args with [ e1; e2 ] -> E.int32_add e1 e2 | _ -> assert false)
   | Paddint64 -> Js_long.add args
   | Paddfloat -> (
       match args with [ e1; e2 ] -> E.float_add e1 e2 | _ -> assert false)
+  | Paddbigint -> (
+    match args with [ e1; e2 ] -> E.bigint_add e1 e2 | _ -> assert false)
   | Psubint -> (
       match args with [ e1; e2 ] -> E.int32_minus e1 e2 | _ -> assert false)
   | Psubint64 -> Js_long.sub args
   | Psubfloat -> (
       match args with [ e1; e2 ] -> E.float_minus e1 e2 | _ -> assert false)
+  | Psubbigint -> (
+      match args with [ e1; e2 ] -> E.bigint_minus e1 e2 | _ -> assert false)
   | Pmulint -> (
       match args with [ e1; e2 ] -> E.int32_mul e1 e2 | _ -> assert false)
   | Pmulint64 -> Js_long.mul args
   | Pmulfloat -> (
       match args with [ e1; e2 ] -> E.float_mul e1 e2 | _ -> assert false)
+  | Pmulbigint -> (
+      match args with [ e1; e2 ] -> E.bigint_mul e1 e2 | _ -> assert false)
   | Pdivfloat -> (
       match args with [ e1; e2 ] -> E.float_div e1 e2 | _ -> assert false)
   | Pdivint -> (
       match args with
       | [ e1; e2 ] -> E.int32_div ~checked:!Js_config.check_div_by_zero e1 e2
       | _ -> assert false)
   | Pdivint64 -> Js_long.div args
+  | Pdivbigint -> (match args with [ e1; e2 ] -> E.bigint_div e1 e2 | _ -> assert false)
   | Pmodint -> (
       match args with
       | [ e1; e2 ] -> E.int32_mod ~checked:!Js_config.check_div_by_zero e1 e2
       | _ -> assert false)
   | Pmodint64 -> Js_long.mod_ args
+  | Pmodbigint -> (match args with [ e1; e2 ] -> E.bigint_mod e1 e2 | _ -> assert false)
   | Plslint -> (
       match args with [ e1; e2 ] -> E.int32_lsl e1 e2 | _ -> assert false)
   | Plslint64 -> Js_long.lsl_ args

jscomp/core/lam_constant_convert.ml

@@ -36,7 +36,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
   | Const_base (Const_float i) -> Const_float i
   | Const_base (Const_int32 i) -> Const_int { i; comment = None }
   | Const_base (Const_int64 i) -> Const_int64 i
-  | Const_base (Const_nativeint _) -> assert false
+  | Const_base (Const_bigint i) -> Const_bigint i
   | Const_pointer (0, Pt_constructor { name = "()"; const = 1; non_const = 0 })
     ->
       Const_js_undefined {isUnit = true}

jscomp/core/lam_convert.ml

@@ -254,6 +254,12 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Psubfloat -> prim ~primitive:Psubfloat ~args loc
   | Pmulfloat -> prim ~primitive:Pmulfloat ~args loc
   | Pdivfloat -> prim ~primitive:Pdivfloat ~args loc
+  | Pnegbigint -> prim ~primitive:Pnegbigint ~args loc
+  | Paddbigint -> prim ~primitive:Paddbigint ~args loc
+  | Psubbigint -> prim ~primitive:Psubbigint ~args loc
+  | Pmulbigint -> prim ~primitive:Pmulbigint ~args loc
+  | Pdivbigint _is_safe (*FIXME*) -> prim ~primitive:Pdivbigint ~args loc
+  | Pmodbigint _is_safe (*FIXME*) -> prim ~primitive:Pmodbigint ~args loc
   | Pintcomp x -> prim ~primitive:(Pintcomp x) ~args loc
   | Poffsetint x -> prim ~primitive:(Poffsetint x) ~args loc
   | Poffsetref x -> prim ~primitive:(Poffsetref x) ~args loc
@@ -266,59 +272,59 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Parraysets -> prim ~primitive:Parraysets ~args loc
   | Pbintofint x -> (
       match x with
-      | Pint32 | Pnativeint -> Ext_list.singleton_exn args
+      | Pint32 | Pbigint -> Ext_list.singleton_exn args
       | Pint64 -> prim ~primitive:Pint64ofint ~args loc)
   | Pintofbint x -> (
       match x with
-      | Pint32 | Pnativeint -> Ext_list.singleton_exn args
+      | Pint32 | Pbigint -> Ext_list.singleton_exn args
       | Pint64 -> prim ~primitive:Pintofint64 ~args loc)
   | Pnegbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Pnegint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Pnegint ~args loc
       | Pint64 -> prim ~primitive:Pnegint64 ~args loc)
   | Paddbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Paddint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Paddint ~args loc
       | Pint64 -> prim ~primitive:Paddint64 ~args loc)
   | Psubbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Psubint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Psubint ~args loc
       | Pint64 -> prim ~primitive:Psubint64 ~args loc)
   | Pmulbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Pmulint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Pmulint ~args loc
       | Pint64 -> prim ~primitive:Pmulint64 ~args loc)
   | Pdivbint { size = x; is_safe = _ } (*FIXME*) -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Pdivint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Pdivint ~args loc
       | Pint64 -> prim ~primitive:Pdivint64 ~args loc)
   | Pmodbint { size = x; is_safe = _ } (*FIXME*) -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Pmodint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Pmodint ~args loc
       | Pint64 -> prim ~primitive:Pmodint64 ~args loc)
   | Pandbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Pandint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Pandint ~args loc
       | Pint64 -> prim ~primitive:Pandint64 ~args loc)
   | Porbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Porint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Porint ~args loc
       | Pint64 -> prim ~primitive:Porint64 ~args loc)
   | Pxorbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Pxorint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Pxorint ~args loc
       | Pint64 -> prim ~primitive:Pxorint64 ~args loc)
   | Plslbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Plslint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Plslint ~args loc
       | Pint64 -> prim ~primitive:Plslint64 ~args loc)
   | Plsrbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Plsrint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Plsrint ~args loc
       | Pint64 -> prim ~primitive:Plsrint64 ~args loc)
   | Pasrbint x -> (
       match x with
-      | Pnativeint | Pint32 -> prim ~primitive:Pasrint ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:Pasrint ~args loc
       | Pint64 -> prim ~primitive:Pasrint64 ~args loc)
   | Pctconst x -> (
       match x with
@@ -333,13 +339,13 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
       | Backend_type -> prim ~primitive:(Pctconst Backend_type) ~args loc)
   | Pcvtbint (a, b) -> (
       match (a, b) with
-      | (Pnativeint | Pint32), (Pnativeint | Pint32) | Pint64, Pint64 ->
+      | (Pbigint | Pint32), (Pbigint | Pint32) | Pint64, Pint64 ->
           Ext_list.singleton_exn args
-      | Pint64, (Pnativeint | Pint32) -> prim ~primitive:Pintofint64 ~args loc
-      | (Pnativeint | Pint32), Pint64 -> prim ~primitive:Pint64ofint ~args loc)
+      | Pint64, (Pbigint | Pint32) -> prim ~primitive:Pintofint64 ~args loc
+      | (Pbigint | Pint32), Pint64 -> prim ~primitive:Pint64ofint ~args loc)
   | Pbintcomp (a, b) -> (
       match a with
-      | Pnativeint | Pint32 -> prim ~primitive:(Pintcomp b) ~args loc
+      | Pbigint | Pint32 -> prim ~primitive:(Pintcomp b) ~args loc
       | Pint64 -> prim ~primitive:(Pint64comp b) ~args loc)
   | Popaque -> Ext_list.singleton_exn args
 

jscomp/core/lam_primitive.ml

@@ -79,6 +79,13 @@ type t =
   | Psubfloat
   | Pmulfloat
   | Pdivfloat
+  (* Bigint operations *)
+  | Pnegbigint
+  | Paddbigint
+  | Psubbigint
+  | Pmulbigint
+  | Pdivbigint
+  | Pmodbigint
   | Pintcomp of Lam_compat.comparison
   | Pfloatcomp of Lam_compat.comparison
   | Pjscomp of Lam_compat.comparison
@@ -200,6 +207,12 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
   | Psubfloat -> rhs = Psubfloat
   | Pmulfloat -> rhs = Pmulfloat
   | Pdivfloat -> rhs = Pdivfloat
+  | Pnegbigint -> rhs = Pnegbigint
+  | Paddbigint -> rhs = Paddbigint
+  | Psubbigint -> rhs = Psubbigint
+  | Pmulbigint -> rhs = Pmulbigint
+  | Pdivbigint -> rhs = Pdivbigint
+  | Pmodbigint -> rhs = Pmodbigint
   | Pjs_apply -> rhs = Pjs_apply
   | Pjs_runtime_apply -> rhs = Pjs_runtime_apply
   | Pstringlength -> rhs = Pstringlength

jscomp/core/lam_primitive.mli

@@ -70,6 +70,12 @@ type t =
   | Psubfloat
   | Pmulfloat
   | Pdivfloat
+  | Pnegbigint
+  | Paddbigint
+  | Psubbigint
+  | Pmulbigint
+  | Pdivbigint
+  | Pmodbigint
   | Pintcomp of Lam_compat.comparison
   | Pfloatcomp of Lam_compat.comparison
   | Pjscomp of Lam_compat.comparison