Upgrade exponentiation to unified operator

cometkim · cometkim · commit dff6374b321a · 2024-11-09T09:17:08.000+09:00
Also make its output to use ES7 exponentiation (`**`) operator.

`**` is more concise, faster than `Math.pow()`,
works well with all numeric types include bigint.

We were already using it for bigint, now for int and float too.
diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml
@@ -1533,6 +1533,7 @@ let unchecked_int32_minus ?comment e1 e2 : J.expression =
   float_minus ?comment e1 e2
 
 let float_div ?comment e1 e2 = bin ?comment Div e1 e2
+let float_pow ?comment e1 e2 = bin ?comment Pow e1 e2
 let float_notequal ?comment e1 e2 = bin ?comment NotEqEq e1 e2
 
 let int32_asr ?comment e1 e2 : J.expression =
@@ -1604,6 +1605,12 @@ let int32_mul ?comment (e1 : J.expression) (e2 : J.expression) : J.expression =
 let unchecked_int32_mul ?comment e1 e2 : J.expression =
   {comment; expression_desc = Bin (Mul, e1, e2)}
 
+let int32_pow ?comment (e1 : t) (e2 : t) : J.expression =
+  match (e1.expression_desc, e2.expression_desc) with
+  | Number (Int {i = i1}), Number (Int {i = i2}) ->
+    int ?comment (Ext_int.int32_pow i1 i2)
+  | _ -> {comment; expression_desc = Bin (Pow, e1, e2)}
+
 let rec int32_bxor ?comment (e1 : t) (e2 : t) : J.expression =
   match (e1.expression_desc, e2.expression_desc) with
   | Number (Int {i = i1}), Number (Int {i = i2}) ->
diff --git a/compiler/core/js_exp_make.mli b/compiler/core/js_exp_make.mli
@@ -251,6 +251,8 @@ val int32_div : checked:bool -> ?comment:string -> t -> t -> t
 
 val int32_mod : checked:bool -> ?comment:string -> t -> t -> t
 
+val int32_pow : ?comment:string -> t -> t -> t
+
 val int32_lsl : ?comment:string -> t -> t -> t
 
 val int32_lsr : ?comment:string -> t -> t -> t
@@ -275,6 +277,8 @@ val float_notequal : ?comment:string -> t -> t -> t
 
 val float_mod : ?comment:string -> t -> t -> t
 
+val float_pow : ?comment:string -> t -> t -> t
+
 val int_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
 
 val bool_comp : Lam_compat.comparison -> ?comment:string -> t -> t -> t
diff --git a/compiler/core/js_op.ml b/compiler/core/js_op.ml
@@ -105,7 +105,8 @@ type int_op =
   | Div
   (* x / y | 0 *)
   | Mod
-(* x  % y *)
+  (* x  % y *)
+  | Pow
 
 (* https://developer.mozilla.org/en-US/docs/Web/JavaScript/Guide/Expressions_and_Operators#Bitwise_operators
    {[
diff --git a/compiler/core/js_op_util.ml b/compiler/core/js_op_util.ml
@@ -40,7 +40,8 @@ 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 | Pow -> (12, 12, 13)
+  | Mul | Div | Mod -> (12, 12, 13)
+  | Pow -> (12, 14, 12)
 
 let op_int_prec (op : Js_op.int_op) =
   match op with
@@ -50,6 +51,7 @@ let op_int_prec (op : Js_op.int_op) =
   | Lsl | Lsr | Asr -> (10, 10, 11)
   | Plus | Minus -> (11, 11, 12)
   | Mul | Div | Mod -> (12, 12, 13)
+  | Pow -> (12, 14, 12)
 
 let op_str (op : Js_op.binop) =
   match op with
@@ -89,6 +91,7 @@ let op_int_str (op : Js_op.int_op) =
   | Mul -> "*"
   | Div -> "/"
   | Mod -> "%"
+  | Pow -> "**"
 
 let str_of_used_stats x =
   match (x : Js_op.used_stats) with
diff --git a/compiler/core/lam_analysis.ml b/compiler/core/lam_analysis.ml
@@ -59,12 +59,13 @@ let rec no_side_effects (lam : Lam.t) : bool =
     (* bool primitives *)
     | Psequand | Psequor | Pnot | Pboolcomp _ | Pboolorder | Pboolmin | Pboolmax
     (* int primitives *)
-    | Pnegint | Paddint | Psubint | Pmulint | Pandint | Porint | Pxorint
-    | Plslint | Plsrint | Pasrint | Pintcomp _ | Pintorder | Pintmin | Pintmax
+    | Pnegint | Paddint | Psubint | Pmulint | Ppowint | Pandint | Porint
+    | Pxorint | Plslint | Plsrint | Pasrint | Pintcomp _ | Pintorder | Pintmin
+    | Pintmax
     (* float primitives *)
     | Pintoffloat | Pfloatofint | Pnegfloat | Paddfloat | Psubfloat | Pmulfloat
-    | Pdivfloat | Pmodfloat | Pfloatcomp _ | Pjscomp _ | Pfloatorder | Pfloatmin
-    | Pfloatmax
+    | Ppowfloat | Pdivfloat | Pmodfloat | Pfloatcomp _ | Pjscomp _ | Pfloatorder
+    | Pfloatmin | Pfloatmax
     (* bigint primitives *)
     | Pnegbigint | Paddbigint | Psubbigint | Pmulbigint | Ppowbigint
     | Pandbigint | Porbigint | Pxorbigint | Plslbigint | Pasrbigint
diff --git a/compiler/core/lam_compile_primitive.ml b/compiler/core/lam_compile_primitive.ml
@@ -250,6 +250,14 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
     match args with
     | [e1; e2] -> E.bigint_mod ~checked:!Js_config.check_div_by_zero e1 e2
     | _ -> assert false)
+  | Ppowint -> (
+    match args with
+    | [e1; e2] -> E.int32_pow e1 e2
+    | _ -> assert false)
+  | Ppowfloat -> (
+    match args with
+    | [e1; e2] -> E.float_pow e1 e2
+    | _ -> assert false)
   | Ppowbigint -> (
     match args with
     | [e1; e2] -> E.bigint_op Pow e1 e2
diff --git a/compiler/core/lam_convert.ml b/compiler/core/lam_convert.ml
@@ -251,6 +251,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Pmulint -> prim ~primitive:Pmulint ~args loc
   | Pdivint _is_safe (*FIXME*) -> prim ~primitive:Pdivint ~args loc
   | Pmodint _is_safe (*FIXME*) -> prim ~primitive:Pmodint ~args loc
+  | Ppowint -> prim ~primitive:Ppowint ~args loc
   | Pandint -> prim ~primitive:Pandint ~args loc
   | Porint -> prim ~primitive:Porint ~args loc
   | Pxorint -> prim ~primitive:Pxorint ~args loc
@@ -283,6 +284,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Pmulfloat -> prim ~primitive:Pmulfloat ~args loc
   | Pdivfloat -> prim ~primitive:Pdivfloat ~args loc
   | Pmodfloat -> prim ~primitive:Pmodfloat ~args loc
+  | Ppowfloat -> prim ~primitive:Ppowfloat ~args loc
   | Pfloatorder -> prim ~primitive:Pfloatorder ~args loc
   | Pfloatmin -> prim ~primitive:Pfloatmin ~args loc
   | Pfloatmax -> prim ~primitive:Pfloatmax ~args loc
diff --git a/compiler/core/lam_primitive.ml b/compiler/core/lam_primitive.ml
@@ -75,6 +75,7 @@ type t =
   | Pmulint
   | Pdivint
   | Pmodint
+  | Ppowint
   | Pandint
   | Porint
   | Pxorint
@@ -96,6 +97,7 @@ type t =
   | Pmulfloat
   | Pdivfloat
   | Pmodfloat
+  | Ppowfloat
   | Pfloatcomp of Lam_compat.comparison
   | Pfloatorder
   | Pfloatmin
@@ -199,12 +201,12 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
   (* bool primitives *)
   | Psequand | Psequor | Pnot | Pboolcomp _ | Pboolorder | Pboolmin | Pboolmax
   (* int primitives *)
-  | Pisint | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint | Pandint
-  | Porint | Pxorint | Plslint | Plsrint | Pasrint | Pintorder | Pintmin
-  | Pintmax
+  | Pisint | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint | Ppowint
+  | Pandint | Porint | Pxorint | Plslint | Plsrint | Pasrint | Pintorder
+  | Pintmin | Pintmax
   (* float primitives *)
   | Pintoffloat | Pfloatofint | Pnegfloat | Paddfloat | Psubfloat | Pmulfloat
-  | Pdivfloat | Pmodfloat | Pfloatorder | Pfloatmin | Pfloatmax
+  | Pdivfloat | Pmodfloat | Ppowfloat | Pfloatorder | Pfloatmin | Pfloatmax
   (* bigint primitives *)
   | Pnegbigint | Paddbigint | Psubbigint | Pmulbigint | Pdivbigint | Pmodbigint
   | Ppowbigint | Pandbigint | Porbigint | Pxorbigint | Plslbigint | Pasrbigint
diff --git a/compiler/core/lam_primitive.mli b/compiler/core/lam_primitive.mli
@@ -69,6 +69,7 @@ type t =
   | Pmulint
   | Pdivint
   | Pmodint
+  | Ppowint
   | Pandint
   | Porint
   | Pxorint
@@ -90,6 +91,7 @@ type t =
   | Pmulfloat
   | Pdivfloat
   | Pmodfloat
+  | Ppowfloat
   | Pfloatcomp of Lam_compat.comparison
   | Pfloatorder
   | Pfloatmin
diff --git a/compiler/core/lam_print.ml b/compiler/core/lam_print.ml
@@ -116,6 +116,7 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Pmulint -> fprintf ppf "*"
   | Pdivint -> fprintf ppf "/"
   | Pmodint -> fprintf ppf "mod"
+  | Ppowint -> fprintf ppf "**"
   | Pandint -> fprintf ppf "and"
   | Porint -> fprintf ppf "or"
   | Pxorint -> fprintf ppf "xor"
@@ -141,6 +142,7 @@ let primitive ppf (prim : Lam_primitive.t) =
   | Pmulfloat -> fprintf ppf "*."
   | Pdivfloat -> fprintf ppf "/."
   | Pmodfloat -> fprintf ppf "mod"
+  | Ppowfloat -> fprintf ppf "**"
   | Pfloatcomp Ceq -> fprintf ppf "==."
   | Pfloatcomp Cneq -> fprintf ppf "!=."
   | Pfloatcomp Clt -> fprintf ppf "<."
diff --git a/compiler/ext/ext_int.ml b/compiler/ext/ext_int.ml
@@ -34,3 +34,11 @@ let move = 0x1_0000_0000
 let int32_unsigned_to_int (n : int32) : int =
   let i = Int32.to_int n in
   if i < 0 then i + move else i
+
+let rec int32_pow (a : int32) = function
+  | 0l -> 1l
+  | 1l -> a
+  | n ->
+    let b = int32_pow a (Int32.div n 2l) in
+    let b = Int32.mul b b in
+    Int32.mul b (if Int32.rem n 2l = 0l then 1l else a)
diff --git a/compiler/ext/ext_int.mli b/compiler/ext/ext_int.mli
@@ -33,3 +33,5 @@ val int32_unsigned_to_int : int32 -> int
    works on 64 bit platform only
    given input as an uint32 and convert it io int64
 *)
+
+val int32_pow : int32 -> int32 -> int32
diff --git a/compiler/ml/lambda.ml b/compiler/ml/lambda.ml
@@ -220,6 +220,7 @@ type primitive =
   | Pmulint
   | Pdivint of is_safe
   | Pmodint of is_safe
+  | Ppowint
   | Pandint
   | Porint
   | Pxorint
@@ -242,6 +243,7 @@ type primitive =
   | Psubfloat
   | Pmulfloat
   | Pdivfloat
+  | Ppowfloat
   | Pfloatcomp of comparison
   | Pfloatorder
   | Pfloatmin
diff --git a/compiler/ml/lambda.mli b/compiler/ml/lambda.mli
@@ -183,6 +183,7 @@ type primitive =
   | Pmulint
   | Pdivint of is_safe
   | Pmodint of is_safe
+  | Ppowint
   | Pandint
   | Porint
   | Pxorint
@@ -205,6 +206,7 @@ type primitive =
   | Psubfloat
   | Pmulfloat
   | Pdivfloat
+  | Ppowfloat
   | Pfloatcomp of comparison
   | Pfloatorder
   | Pfloatmin
diff --git a/compiler/ml/printlambda.ml b/compiler/ml/printlambda.ml
@@ -156,6 +156,7 @@ let primitive ppf = function
   | Pdivint Unsafe -> fprintf ppf "/u"
   | Pmodint Safe -> fprintf ppf "mod"
   | Pmodint Unsafe -> fprintf ppf "mod_unsafe"
+  | Ppowint -> fprintf ppf "**"
   | Pandint -> fprintf ppf "and"
   | Porint -> fprintf ppf "or"
   | Pxorint -> fprintf ppf "xor"
@@ -182,6 +183,7 @@ let primitive ppf = function
   | Pmulfloat -> fprintf ppf "*."
   | Pdivfloat -> fprintf ppf "/."
   | Pmodfloat -> fprintf ppf "mod"
+  | Ppowfloat -> fprintf ppf "**"
   | Pfloatcomp Ceq -> fprintf ppf "==."
   | Pfloatcomp Cneq -> fprintf ppf "!=."
   | Pfloatcomp Clt -> fprintf ppf "<."
diff --git a/compiler/ml/unified_ops.ml b/compiler/ml/unified_ops.ml
@@ -148,6 +148,19 @@ let entries =
           string = None;
         };
     };
+    {
+      path = builtin "**";
+      name = "%pow";
+      form = Binary;
+      specialization =
+        {
+          int = Ppowint;
+          bool = None;
+          float = Some Ppowfloat;
+          bigint = Some Ppowbigint;
+          string = None;
+        };
+    };
   |]
 
 let index_by_path =
diff --git a/compiler/syntax/src/res_parens.ml b/compiler/syntax/src/res_parens.ml
@@ -148,12 +148,14 @@ let binary_expr_operand ~is_lhs expr =
       else Nothing)
 
 let sub_binary_expr_operand parent_operator child_operator =
-  let prec_parent = ParsetreeViewer.operator_precedence parent_operator in
-  let prec_child = ParsetreeViewer.operator_precedence child_operator in
+  let open ParsetreeViewer in
+  let prec_parent = operator_precedence parent_operator in
+  let prec_child = operator_precedence child_operator in
+  Printf.eprintf "parent %s, %d; child %s, %d" parent_operator prec_parent
+    child_operator prec_child;
   prec_parent > prec_child
-  || prec_parent == prec_child
-     && not
-          (ParsetreeViewer.flattenable_operators parent_operator child_operator)
+  || is_equality_operator parent_operator
+     && is_equality_operator child_operator
   || (* a && b || c, add parens to (a && b) for readability, who knows the difference by heart… *)
   (parent_operator = "||" && child_operator = "&&")
 
diff --git a/compiler/syntax/src/res_parsetree_viewer.mli b/compiler/syntax/src/res_parsetree_viewer.mli
@@ -81,6 +81,7 @@ val is_unary_expression : Parsetree.expression -> bool
 val is_binary_operator : string -> bool
 val is_binary_expression : Parsetree.expression -> bool
 val is_rhs_binary_operator : string -> bool
+val is_equality_operator : string -> bool
 
 val flattenable_operators : string -> string -> bool
 
diff --git a/runtime/Pervasives.res b/runtime/Pervasives.res
@@ -50,6 +50,7 @@ external \"-": ('a, 'a) => 'a = "%sub"
 external \"*": ('a, 'a) => 'a = "%mul"
 external \"/": ('a, 'a) => 'a = "%div"
 external mod: ('a, 'a) => 'a = "%mod"
+external \"**": ('a, 'a) => 'a = "%pow"
 
 /* Comparisons */
 /* Note: Later comparisons will be converted to unified operations too */
@@ -113,9 +114,6 @@ external \"-.": (float, float) => float = "%subfloat"
 external \"*.": (float, float) => float = "%mulfloat"
 external \"/.": (float, float) => float = "%divfloat"
 
-@deprecated("Use Core instead. This will be removed in v13") @val @scope("Math")
-external \"**": (float, float) => float = "pow"
-
 @deprecated("Use Core instead. This will be removed in v13") @val @scope("Math")
 external exp: float => float = "exp"
 
diff --git a/runtime/Pervasives_mini.res b/runtime/Pervasives_mini.res
@@ -29,6 +29,7 @@ external \"-": (int, int) => int = "%subint"
 external \"*": (int, int) => int = "%mulint"
 external \"/": (int, int) => int = "%divint"
 external mod: (int, int) => int = "%modint"
+external \"**": (int, int) => int = "%powint"
 
 /* Comparisons */
 /* Note: Later comparisons will be converted to unified operations too */
diff --git a/tests/tests/src/b.mjs b/tests/tests/src/b.mjs
@@ -4,7 +4,7 @@
 function f(point) {
   let y = point.y;
   let x = point.x;
-  return Math.pow(x * x + y * y, 2);
+  return (x * x + y * y) ** 2;
 }
 
 export {
diff --git a/tests/tests/src/exponentiation_precedence_test.mjs b/tests/tests/src/exponentiation_precedence_test.mjs
@@ -1,18 +1,18 @@
 // Generated by ReScript, PLEASE EDIT WITH CARE
 
 
-let a = Math.pow(2, Math.pow(3, 2));
+let a = 2 ** 3 ** 2;
 
-let b = Math.pow(2, Math.pow(-3, 2));
+let b = 2 ** (-3) ** 2;
 
-let c = Math.pow(Math.pow(2, 3), 2);
+let c = (2 ** 3) ** 2;
 
-let d = Math.pow(-2, 2);
+let d = (-2) ** 2;
 
 export {
   a,
   b,
   c,
   d,
 }
-/* a Not a pure module */
+/* No side effect */
diff --git a/tests/tests/src/test_pervasive.mjs b/tests/tests/src/test_pervasive.mjs
@@ -187,7 +187,7 @@ function a17(prim) {
 }
 
 function a18(prim0, prim1) {
-  return Math.pow(prim0, prim1);
+  return prim0 ** prim1;
 }
 
 let f = Pervasives.$at;
diff --git a/tests/tests/src/unified_ops_test.mjs b/tests/tests/src/unified_ops_test.mjs
@@ -51,6 +51,12 @@ function case2(a, b) {
   return a + "test" + b;
 }
 
+let pow1 = 4;
+
+let pow2 = 2 ** 2;
+
+let pow3 = 2n ** 2n;
+
 let int = 3;
 
 export {
@@ -69,5 +75,8 @@ export {
   rhsstring,
   case1,
   case2,
+  pow1,
+  pow2,
+  pow3,
 }
 /* No side effect */
diff --git a/tests/tests/src/unified_ops_test.res b/tests/tests/src/unified_ops_test.res
diff --git a/tests/tests/src/variantsMatching.mjs b/tests/tests/src/variantsMatching.mjs
