add bitwise operations

Author: mununki

jscomp/core/lam_analysis.ml

@@ -76,8 +76,10 @@ let rec no_side_effects (lam : Lam.t) : bool =
       (* Float operations *)
       | Pintoffloat | Pfloatofint | Pnegfloat
       (* | Pabsfloat *)
-      | Paddfloat | Psubfloat | Pmulfloat | Pdivfloat | Pfloatcomp _ | Pbigintcomp _ | Pjscomp _
+      | 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

jscomp/core/lam_compile_primitive.ml

@@ -225,6 +225,8 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
   | Plslint -> (
       match args with [ e1; e2 ] -> E.int32_lsl e1 e2 | _ -> assert false)
   | Plslint64 -> Js_long.lsl_ args
+  | Plslbigint -> (
+      match args with [ e1; e2 ] -> E.bigint_op Lsl e1 e2 | _ -> assert false)
   | Plsrint -> (
       match args with
       | [ e1; { J.expression_desc = Number (Int { i = 0l; _ } | Uint 0l); _ } ]
@@ -236,15 +238,23 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
   | Pasrint -> (
       match args with [ e1; e2 ] -> E.int32_asr e1 e2 | _ -> assert false)
   | Pasrint64 -> Js_long.asr_ args
+  | Pasrbigint -> (
+      match args with [ e1; e2 ] -> E.bigint_op Asr e1 e2 | _ -> assert false)
   | Pandint -> (
       match args with [ e1; e2 ] -> E.int32_band e1 e2 | _ -> assert false)
   | Pandint64 -> Js_long.and_ args
+  | Pandbigint -> (
+      match args with [ e1; e2 ] -> E.bigint_op Band e1 e2 | _ -> assert false)
   | Porint -> (
       match args with [ e1; e2 ] -> E.int32_bor e1 e2 | _ -> assert false)
   | Porint64 -> Js_long.or_ args
+  | Porbigint -> (
+      match args with [ e1; e2 ] -> E.bigint_op Bor e1 e2 | _ -> assert false)
   | Pxorint -> (
       match args with [ e1; e2 ] -> E.int32_bxor e1 e2 | _ -> assert false)
   | Pxorint64 -> Js_long.xor args
+  | Pxorbigint -> (
+      match args with [ e1; e2 ] -> E.bigint_op Bxor e1 e2 | _ -> assert false)
   | Pjscomp cmp -> (
       match args with [ l; r ] -> E.js_comp cmp l r | _ -> assert false)
   | Pfloatcomp cmp | Pintcomp cmp -> (

jscomp/core/lam_convert.ml

@@ -261,6 +261,11 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Pdivbigint _is_safe (*FIXME*) -> prim ~primitive:Pdivbigint ~args loc
   | Pmodbigint _is_safe (*FIXME*) -> prim ~primitive:Pmodbigint ~args loc
   | Ppowbigint -> prim ~primitive:Ppowbigint ~args loc
+  | Pandbigint -> prim ~primitive:Pandbigint ~args loc
+  | Porbigint -> prim ~primitive:Porbigint ~args loc
+  | Pxorbigint -> prim ~primitive:Pxorbigint ~args loc
+  | Plslbigint -> prim ~primitive:Plslbigint ~args loc
+  | Pasrbigint -> prim ~primitive:Pasrbigint ~args loc
   | Pbigintcomp x -> prim ~primitive:(Pbigintcomp x) ~args loc
   | Pintcomp x -> prim ~primitive:(Pintcomp x) ~args loc
   | Poffsetint x -> prim ~primitive:(Poffsetint x) ~args loc

jscomp/core/lam_primitive.ml

@@ -87,6 +87,11 @@ type t =
   | Pdivbigint
   | Pmodbigint
   | Ppowbigint
+  | Pandbigint
+  | Porbigint
+  | Pxorbigint
+  | Plslbigint
+  | Pasrbigint
   | Pintcomp of Lam_compat.comparison
   | Pfloatcomp of Lam_compat.comparison
   | Pjscomp of Lam_compat.comparison
@@ -216,6 +221,11 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
   | Pdivbigint -> rhs = Pdivbigint
   | Pmodbigint -> rhs = Pmodbigint
   | Ppowbigint -> rhs = Ppowbigint
+  | Pandbigint -> rhs = Pandbigint
+  | Porbigint -> rhs = Porbigint
+  | Pxorbigint -> rhs = Pxorbigint
+  | Plslbigint -> rhs = Plslbigint
+  | Pasrbigint -> rhs = Pasrbigint
   | Pjs_apply -> rhs = Pjs_apply
   | Pjs_runtime_apply -> rhs = Pjs_runtime_apply
   | Pstringlength -> rhs = Pstringlength

jscomp/core/lam_primitive.mli

@@ -77,6 +77,11 @@ type t =
   | Pdivbigint
   | Pmodbigint
   | Ppowbigint
+  | Pandbigint
+  | Porbigint
+  | Pxorbigint
+  | Plslbigint
+  | Pasrbigint
   | Pintcomp of Lam_compat.comparison
   | Pfloatcomp of Lam_compat.comparison
   | Pjscomp of Lam_compat.comparison

jscomp/core/lam_print.ml

@@ -141,6 +141,11 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Pdivbigint -> fprintf ppf "/,"
   | Pmodbigint -> fprintf ppf "modn"
   | Ppowbigint -> fprintf ppf "**,"
+  | Pandbigint -> fprintf ppf "and,"
+  | Porbigint -> fprintf ppf "or,"
+  | Pxorbigint -> fprintf ppf "xor,"
+  | Plslbigint -> fprintf ppf "lsl,"
+  | Pasrbigint -> fprintf ppf "asr,"
   | Pbigintcomp Ceq -> fprintf ppf "==,"
   | Pbigintcomp Cneq -> fprintf ppf "!=,"
   | Pbigintcomp Clt -> fprintf ppf "<,"

jscomp/ml/lambda.ml

@@ -232,6 +232,8 @@ type primitive =
   (* Bigint operations *)
   | Pnegbigint | Paddbigint | Psubbigint | Ppowbigint
   | Pmulbigint | Pdivbigint of is_safe | Pmodbigint of is_safe
+  | Pandbigint | Porbigint | Pxorbigint
+  | Plslbigint | Pasrbigint
   | Pbigintcomp of comparison
   (* String operations *)
   | Pstringlength | Pstringrefu  | Pstringrefs

jscomp/ml/lambda.mli

@@ -198,6 +198,8 @@ type primitive =
   (* Bigint operations *)
   | Pnegbigint | Paddbigint | Psubbigint | Ppowbigint
   | Pmulbigint | Pdivbigint of is_safe | Pmodbigint of is_safe
+  | Pandbigint | Porbigint | Pxorbigint
+  | Plslbigint | Pasrbigint
   | Pbigintcomp of comparison
   (* String operations *)
   | Pstringlength | Pstringrefu  | Pstringrefs

jscomp/ml/printlambda.ml

@@ -182,6 +182,11 @@ let primitive ppf = function
   | Psubbigint -> fprintf ppf "-,"
   | Pmulbigint -> fprintf ppf "*,"
   | Ppowbigint -> fprintf ppf "**,"
+  | Pandbigint -> fprintf ppf "and,"
+  | Porbigint -> fprintf ppf "or,"
+  | Pxorbigint -> fprintf ppf "xor,"
+  | Plslbigint -> fprintf ppf "lsl,"
+  | Pasrbigint -> fprintf ppf "asr,"
   | Pdivbigint Safe -> fprintf ppf "/n"
   | Pdivbigint Unsafe -> fprintf ppf "/nu"
   | Pmodbigint Safe -> fprintf ppf "mod"
@@ -300,6 +305,11 @@ let name_of_primitive = function
   | Pdivbigint _ -> "Pdivbigint"
   | Pmodbigint _ -> "Pmodbigint"
   | Ppowbigint -> "Ppowbigint"
+  | Pandbigint -> "Pandbigint"
+  | Porbigint -> "Porbigint"
+  | Pxorbigint -> "Pxorbigint"
+  | Plslbigint -> "Plslbigint"
+  | Pasrbigint -> "Pasrbigint"
   | Pbigintcomp _ -> "Pbigintcomp"
   | Pstringlength -> "Pstringlength"
   | Pstringrefu -> "Pstringrefu"

jscomp/ml/translcore.ml

@@ -345,6 +345,11 @@ let primitives_table =
       ("%lslint", Plslint);
       ("%lsrint", Plsrint);
       ("%asrint", Pasrint);
+      ("%andbigint", Pandbigint);
+      ("%orbigint", Porbigint);
+      ("%xorbigint", Pxorbigint);
+      ("%lslbigint", Plslbigint);
+      ("%asrbigint", Pasrbigint);
       ("%eq", Pintcomp Ceq);
       ("%noteq", Pintcomp Cneq);
       ("%ltint", Pintcomp Clt);

jscomp/stdlib-406/pervasives.res

@@ -190,6 +190,15 @@ external \"/,": (bigint, bigint) => bigint = "%divbigint"
 external modn: (bigint, bigint) => bigint = "%modbigint"
 external \"**,": (bigint, bigint) => bigint = "%powbigint"
 
+external landn: (bigint, bigint) => bigint = "%andbigint"
+external lorn: (bigint, bigint) => bigint = "%orbigint"
+external lxorn: (bigint, bigint) => bigint = "%xorbigint"
+
+let lnotn = x => lxorn(x, -1n)
+
+external lsln: (bigint, bigint) => bigint = "%lslbigint"
+external asrn: (bigint, bigint) => bigint = "%asrbigint"
+
 /* String and byte sequence operations -- more in modules String and Bytes */
 
 external string_length: string => int = "%string_length"

jscomp/stdlib-406/pervasives.resi

@@ -568,6 +568,33 @@ external modn: (bigint, bigint) => bigint = "%modbigint"
     Left-associative operator at precedence level 7/9. */
 external \"**,": (bigint, bigint) => bigint = "%powbigint"
 
+/** Bigint Bitwise logical and.
+    Left-associative operator at precedence level 7/11. */
+external landn: (bigint, bigint) => bigint = "%andbigint"
+
+/** Bigint Bitwise logical or.
+    Left-associative operator at precedence level 7/11. */
+external lorn: (bigint, bigint) => bigint = "%orbigint"
+
+/** Bigint Bitwise logical exclusive or.
+    Left-associative operator at precedence level 7/11. */
+external lxorn: (bigint, bigint) => bigint = "%xorbigint"
+
+/** Bigint Bitwise logical negation. */
+let lnotn: bigint => bigint
+
+/** [n lsln m] shifts [n] to the left by [m] bits.
+   The result is unspecified if [m < 0n] or [m >= bitsize],
+   where the both operands are bigints.
+   Right-associative operator at precedence level 8/11. */
+external lsln: (bigint, bigint) => bigint = "%lslbigint"
+
+/** [n asrn m] shifts [n] to the right by [m] bits.
+   This is an arithmetic shift: the sign bit of [n] is replicated.
+   The result is unspecified if [m < 0n] or [m >= bitsize].
+   Right-associative operator at precedence level 8/11. */
+external asrn: (bigint, bigint) => bigint = "%asrbigint"
+
 @val
 @scope("Number")
 /** A special floating-point value denoting the result of an

jscomp/stdlib-406/pervasivesU.res

@@ -191,6 +191,15 @@ external \"/,": (bigint, bigint) => bigint = "%divbigint"
 external modn: (bigint, bigint) => bigint = "%modbigint"
 external \"**,": (bigint, bigint) => bigint = "%powbigint"
 
+external landn: (bigint, bigint) => bigint = "%andbigint"
+external lorn: (bigint, bigint) => bigint = "%orbigint"
+external lxorn: (bigint, bigint) => bigint = "%xorbigint"
+
+let lnotn = x => lxorn(x, -1n)
+
+external lsln: (bigint, bigint) => bigint = "%lslbigint"
+external asrn: (bigint, bigint) => bigint = "%asrbigint"
+
 /* String and byte sequence operations -- more in modules String and Bytes */
 
 external string_length: string => int = "%string_length"

jscomp/stdlib-406/pervasivesU.resi

@@ -571,6 +571,33 @@ external modn: (bigint, bigint) => bigint = "%modbigint"
     Left-associative operator at precedence level 7/9. */
 external \"**,": (bigint, bigint) => bigint = "%powbigint"
 
+/** Bigint Bitwise logical and.
+    Left-associative operator at precedence level 7/11. */
+external landn: (bigint, bigint) => bigint = "%andbigint"
+
+/** Bigint Bitwise logical or.
+    Left-associative operator at precedence level 7/11. */
+external lorn: (bigint, bigint) => bigint = "%orbigint"
+
+/** Bigint Bitwise logical exclusive or.
+    Left-associative operator at precedence level 7/11. */
+external lxorn: (bigint, bigint) => bigint = "%xorbigint"
+
+/** Bigint Bitwise logical negation. */
+let lnotn: bigint => bigint
+
+/** [n lsln m] shifts [n] to the left by [m] bits.
+   The result is unspecified if [m < 0n] or [m >= bitsize],
+   where the both operands are bigints.
+   Right-associative operator at precedence level 8/11. */
+external lsln: (bigint, bigint) => bigint = "%lslbigint"
+
+/** [n asrn m] shifts [n] to the right by [m] bits.
+   This is an arithmetic shift: the sign bit of [n] is replicated.
+   The result is unspecified if [m < 0n] or [m >= bitsize].
+   Right-associative operator at precedence level 8/11. */
+external asrn: (bigint, bigint) => bigint = "%asrbigint"
+
 @val
 @scope("Number")
 /** A special floating-point value denoting the result of an