Introducing the bigint

CHANGELOG.md

@@ -12,6 +12,10 @@
 
 # 11.1.0-rc.6 (Unreleased)
 
+#### :rocket: New Feature
+
+- Add the primitive bigint type https://github.com/rescript-lang/rescript-compiler/pull/6670
+
 #### :bug: Bug Fix
 
 - Fix mishandling of uncurried functions in super errors. https://github.com/rescript-lang/rescript-compiler/pull/6694

jscomp/build_tests/super_errors/expected/bigint_match_literal.res.expected

@@ -0,0 +1,11 @@
+
+  Warning number 11
+  /.../fixtures/bigint_match_literal.res:3:3-4
+
+  1 │ let m1 = switch 1n {
+  2 │ | 0001n => 1
+  3 │ | 1n => 1
+  4 │ | -0001n => -1
+  5 │ | _ => 0
+
+  this match case is unused.

jscomp/build_tests/super_errors/expected/variant_coercion_bigint.res.expected

@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/variant_coercion_bigint.res:5:10-20
+
+  3 │ let x = One(true)
+  4 │ 
+  5 │ let y = (x :> bigint)
+  6 │ 
+
+  Type x is not a subtype of bigint

jscomp/build_tests/super_errors/expected/variant_coercion_bigint_as.res.expected

@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/variant_coercion_bigint_as.res:5:10-20
+
+  3 │ let x = One
+  4 │ 
+  5 │ let y = (x :> bigint)
+  6 │ 
+
+  Type x is not a subtype of bigint

jscomp/build_tests/super_errors/expected/warnings4.res.expected

@@ -10,4 +10,4 @@
   14 │ 
 
   You forgot to handle a possible case here, for example: 
-  | #second(_) | #fourth | #third
+  | #second(_) | #fourth | #third

jscomp/build_tests/super_errors/expected/warnings5.res.expected

@@ -187,4 +187,4 @@ Either bind these labels explicitly or add ', _' to the pattern.
   60 │ 
 
   You forgot to handle a possible case here, for example: 
-  | (_, true)
+  | (_, true)

jscomp/build_tests/super_errors/fixtures/bigint_match_literal.res

@@ -0,0 +1,6 @@
+let m1 = switch 1n {
+| 0001n => 1
+| 1n => 1
+| -0001n => -1
+| _ => 0
+}

jscomp/build_tests/super_errors/fixtures/variant_coercion_bigint.res

@@ -0,0 +1,5 @@
+type x = | @as(1n) One(bool) | @as(2n) Two
+
+let x = One(true)
+
+let y = (x :> bigint)

jscomp/build_tests/super_errors/fixtures/variant_coercion_bigint_as.res

@@ -0,0 +1,5 @@
+type x = | @as(1n) One | Two
+
+let x = One
+
+let y = (x :> bigint)

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 {positive = p0; value = v0}) -> (
+    match y0 with Number (Bigint {positive = p1; value = v1}) -> p0 = p1 && v0 = v1 | _ -> 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 {positive; value} -> Format.asprintf "%sn" (Bigint_utils.to_string positive value)
       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 sign i : t = { expression_desc = Number (Bigint {positive=sign; value=i}); comment}
+
+let zero_bigint_literal : t = {expression_desc = Number (Bigint {positive=true; value="0"}); comment = None}
+
 let small_int i : t =
   match i with
   | 0 -> zero_int_literal
@@ -803,11 +807,15 @@ let tag_type = function
   | Ast_untagged_variants.String s -> str s ~delim:DStarJ
   | Int i -> small_int i
   | Float f -> float f
+  | Bigint i -> 
+    let sign, i = Bigint_utils.parse_bigint i in
+    bigint sign i
   | Bool b -> bool b
   | Null -> nil
   | Undefined -> undefined
   | Untagged IntType -> str "number"
   | Untagged FloatType -> str "number"
+  | Untagged BigintType -> str "bigint"
   | Untagged BooleanType -> str "boolean"
   | Untagged FunctionType -> str "function"
   | Untagged StringType -> str "string"
@@ -1253,6 +1261,23 @@ 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_op ?comment op (e1: t) (e2: t) = bin ?comment op e1 e2
+
+let bigint_comp (cmp : Lam_compat.comparison) ?comment (e0: t) (e1: t) =
+  bin ?comment (Lam_compile_util.jsop_of_comp cmp) e0 e1
+
+let bigint_div ~checked ?comment (e0: t) (e1: t) =
+  if checked then
+    runtime_call Js_runtime_modules.bigint "div" [e0; e1]
+  else
+    bigint_op ?comment Div e0 e1
+
+let bigint_mod ~checked ?comment (e0: t) (e1: t) =
+  if checked then
+    runtime_call Js_runtime_modules.bigint "mod_" [e0; e1]
+  else
+    bigint_op ?comment Mod e0 e1
+
 (* 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 -> bool -> 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,14 @@ val string_comp : Js_op.binop -> ?comment:string -> t -> t -> t
 
 val float_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
 
+val bigint_op : ?comment: string -> Js_op.binop -> t -> t -> t
+
+val bigint_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
+
+val bigint_div : checked:bool -> ?comment:string -> t -> t -> t
+
+val bigint_mod : checked:bool -> ?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

@@ -48,6 +48,7 @@ type binop =
   | Mul
   | Div
   | Mod
+  | Pow
   | InstanceOf
 
 (**
@@ -125,10 +126,13 @@ type 'a access = Getter | Setter
 (* literal char *)
 type float_lit = { f : string } [@@unboxed]
 
+type bigint_lit = { positive: bool; value: string }
+
 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/js_op_util.ml

@@ -40,7 +40,7 @@ let op_prec (op : Js_op.binop) =
   | Band -> (7, 7, 7)
   | Lsl | Lsr | Asr -> (10, 10, 11)
   | Plus | Minus -> (11, 11, 12)
-  | Mul | Div | Mod -> (12, 12, 13)
+  | Mul | Div | Mod | Pow -> (12, 12, 13)
 
 let op_int_prec (op : Js_op.int_op) =
   match op with
@@ -64,6 +64,7 @@ let op_str (op : Js_op.binop) =
   | Mul -> "*"
   | Div -> "/"
   | Mod -> "%"
+  | Pow -> "**"
   | Eq -> "="
   | Or -> "||"
   | And -> "&&"

jscomp/core/js_stmt_make.ml

@@ -138,7 +138,7 @@ let string_switch ?(comment : string option)
             match switch_case with
             | String s ->
               if s = txt then Some x.switch_body else None
-            | Int _  | Float _| Bool _ | Null | Undefined | Untagged _ ->
+            | Int _  | Float _ | Bigint _ | Bool _ | Null | Undefined | Untagged _ ->
               None)
         with
         | Some case -> case

jscomp/core/lam.ml

@@ -506,6 +506,7 @@ let prim ~primitive:(prim : Lam_primitive.t) ~args loc : t =
           (* FIXME: could raise? *)
           Lift.bool
             (Lam_compat.cmp_float cmp (float_of_string a) (float_of_string b))
+      | Pbigintcomp cmp, Const_bigint _, Const_bigint _ -> default ()
       | Pintcomp ((Ceq | Cneq) as op), Const_pointer a, Const_pointer b ->
           Lift.bool
             (match op with
@@ -641,7 +642,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,9 @@ let rec no_side_effects (lam : Lam.t) : bool =
       | Pintoffloat | Pfloatofint | Pnegfloat
       (* | Pabsfloat *)
       | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat | Pfloatcomp _ | Pjscomp _
+      | Pnegbigint | Paddbigint | Psubbigint | Pmulbigint | Ppowbigint
+      | Pandbigint | Porbigint | Pxorbigint | Plslbigint | Pasrbigint
+      | Pbigintcomp _
       (* String operations *)
       | Pstringlength | Pstringrefu | Pstringrefs | Pbyteslength | Pbytesrefu
       | Pbytesrefs | Pmakearray | Parraylength | Parrayrefu | Parrayrefs
@@ -193,7 +197,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
@@ -76,7 +67,7 @@ let cmp_float (cmp : comparison) (a : float) b : bool =
   | Cle -> a <= b
   | Clt -> a < b
   | Cge -> a >= b
-
+  
 let cmp_int (cmp : comparison) (a : int) 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 (sign, i) -> E.bigint sign 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