Add shift operators (<<, >>, >>>) (#7183)

Resolved #7171

---------

Co-authored-by: Hyeseong Kim <[email protected]>

Author: gwansikk

CHANGELOG.md

@@ -12,6 +12,10 @@
 
 # 12.0.0-alpha.13 (Unreleased)
 
+#### :rocket: New Feature
+
+- Add shift (`<<`, `>>`, `>>>`) operators for `int` and `bigint`. https://github.com/rescript-lang/rescript/pull/7183
+
 # 12.0.0-alpha.12
 
 #### :bug: Bug fix

compiler/ml/unified_ops.ml

@@ -148,6 +148,39 @@ let entries =
           string = None;
         };
     };
+    {
+      path = builtin "<<";
+      name = "%lsl";
+      form = Binary;
+      specialization =
+        {
+          int = Plslint;
+          bool = None;
+          float = None;
+          bigint = Some Plslbigint;
+          string = None;
+        };
+    };
+    {
+      path = builtin ">>";
+      name = "%asr";
+      form = Binary;
+      specialization =
+        {
+          int = Pasrint;
+          bool = None;
+          float = None;
+          bigint = Some Pasrbigint;
+          string = None;
+        };
+    };
+    {
+      path = builtin ">>>";
+      name = "%lsr";
+      form = Binary;
+      specialization =
+        {int = Plsrint; bool = None; float = None; bigint = None; string = None};
+    };
     {
       path = builtin "mod";
       name = "%mod";

compiler/syntax/src/res_parsetree_viewer.ml

@@ -274,10 +274,11 @@ let operator_precedence operator =
   | "&&" -> 3
   | "^" -> 4
   | "==" | "===" | "<" | ">" | "!=" | "<>" | "!==" | "<=" | ">=" | "|>" -> 5
-  | "+" | "+." | "-" | "-." | "++" -> 6
-  | "*" | "*." | "/" | "/." | "%" -> 7
-  | "**" -> 8
-  | "#" | "##" | "->" -> 9
+  | "<<" | ">>" | ">>>" -> 6
+  | "+" | "+." | "-" | "-." | "++" -> 7
+  | "*" | "*." | "/" | "/." | "%" -> 8
+  | "**" -> 9
+  | "#" | "##" | "->" -> 10
   | _ -> 0
 
 let is_unary_operator operator =
@@ -300,7 +301,7 @@ let is_binary_operator operator =
   match operator with
   | ":=" | "||" | "&&" | "==" | "===" | "<" | ">" | "!=" | "!==" | "<=" | ">="
   | "|>" | "+" | "+." | "-" | "-." | "++" | "*" | "*." | "/" | "/." | "**"
-  | "->" | "<>" | "%" | "^" ->
+  | "->" | "<>" | "%" | "^" | "<<" | ">>" | ">>>" ->
     true
   | _ -> false
 

compiler/syntax/src/res_scanner.ml

@@ -886,16 +886,30 @@ let rec scan scanner =
       | _ ->
         next scanner;
         Token.Plus)
-    | '>' -> (
+    | '>' when not (in_diamond_mode scanner) -> (
       match peek scanner with
-      | '=' when not (in_diamond_mode scanner) ->
+      | '=' ->
         next2 scanner;
         Token.GreaterEqual
+      | '>' -> (
+        match peek2 scanner with
+        | '>' ->
+          next3 scanner;
+          Token.RightShiftUnsigned
+        | _ ->
+          next2 scanner;
+          Token.RightShift)
       | _ ->
         next scanner;
         Token.GreaterThan)
+    | '>' ->
+      next scanner;
+      Token.GreaterThan
     | '<' when not (in_jsx_mode scanner) -> (
       match peek scanner with
+      | '<' when not (in_diamond_mode scanner) ->
+        next2 scanner;
+        Token.LeftShift
       | '=' ->
         next2 scanner;
         Token.LessEqual

compiler/syntax/src/res_token.ml

@@ -98,6 +98,9 @@ type t =
   | Try
   | DocComment of Location.t * string
   | ModuleComment of Location.t * string
+  | LeftShift
+  | RightShift
+  | RightShiftUnsigned
 
 let precedence = function
   | HashEqual | ColonEqual -> 1
@@ -107,11 +110,12 @@ let precedence = function
   | Equal | EqualEqual | EqualEqualEqual | LessThan | GreaterThan | BangEqual
   | BangEqualEqual | LessEqual | GreaterEqual | BarGreater ->
     5
-  | Plus | PlusDot | Minus | MinusDot | PlusPlus -> 6
-  | Asterisk | AsteriskDot | Forwardslash | ForwardslashDot | Percent -> 7
-  | Exponentiation -> 8
-  | MinusGreater -> 9
-  | Dot -> 10
+  | LeftShift | RightShift | RightShiftUnsigned -> 6
+  | Plus | PlusDot | Minus | MinusDot | PlusPlus -> 7
+  | Asterisk | AsteriskDot | Forwardslash | ForwardslashDot | Percent -> 8
+  | Exponentiation -> 9
+  | MinusGreater -> 10
+  | Dot -> 11
   | _ -> 0
 
 let to_string = function
@@ -212,6 +216,9 @@ let to_string = function
   | Try -> "try"
   | DocComment (_loc, s) -> "DocComment " ^ s
   | ModuleComment (_loc, s) -> "ModuleComment " ^ s
+  | LeftShift -> "<<"
+  | RightShift -> ">>"
+  | RightShiftUnsigned -> ">>>"
 
 let keyword_table = function
   | "and" -> And

runtime/Pervasives.res

@@ -65,9 +65,12 @@ external \"-": ('a, 'a) => 'a = "%sub"
 external \"*": ('a, 'a) => 'a = "%mul"
 external \"/": ('a, 'a) => 'a = "%div"
 external \"%": ('a, 'a) => 'a = "%mod"
+external \"<<": ('a, 'a) => 'a = "%lsl"
 external mod: ('a, 'a) => 'a = "%mod"
 external \"**": ('a, 'a) => 'a = "%pow"
 external \"^": ('a, 'a) => 'a = "%bitxor"
+external \">>": ('a, 'a) => 'a = "%asr"
+external \">>>": ('a, 'a) => 'a = "%lsr"
 
 /* Comparisons */
 /* Note: Later comparisons will be converted to unified operations too */

tests/syntax_tests/data/parsing/errors/typexpr/expected/typeConstructorArgs.res.txt

@@ -38,18 +38,20 @@
 
 
   Syntax error!
-  syntax_tests/data/parsing/errors/typexpr/typeConstructorArgs.res:9:28
+  syntax_tests/data/parsing/errors/typexpr/typeConstructorArgs.res:8:16-17
 
+   6 │ type t<'a> = private Belt.Map.t('a)
    7 │ 
    8 │ type t = option<<node<int>>
    9 │ type t = option(<node<int>>)
   10 │ 
 
-  I'm not sure what to parse here when looking at ")".
+  I'm not sure what to parse here when looking at "<<".
 
 type nonrec 'a node = {
   _value: 'a Js.Nullable.value }
 type nonrec 'a t = 'a Belt.Map.t
 type nonrec 'a t = private 'a Belt.Map.t
-type nonrec t = int node option
+type nonrec t = option
+;;node < (int >> ([%rescript.exprhole ]))
 type nonrec t = int node option

tests/syntax_tests/data/parsing/grammar/expressions/binary.res

@@ -29,6 +29,9 @@ let x = a + -1 + -2
 let x = a + @attr -1 + @attr -2
 let x = a % a == 0
 let x = a ^ a == 0
+let x = a << a == 0
+let x = a >> a == 0
+let x = a >>> a == 0
 
 // should be interpreted as binary expression not prefix op
 let x = a -b

tests/syntax_tests/data/parsing/grammar/expressions/expected/binary.res.txt

@@ -15,6 +15,9 @@ let x = (a + (-1)) + (-2)
 let x = (a + (((-1))[@attr ])) + (((-2))[@attr ])
 let x = (a % a) == 0
 let x = a ^ (a == 0)
+let x = (a << a) == 0
+let x = (a >> a) == 0
+let x = (a >>> a) == 0
 let x = a - b
 let x = a -. b
 ;;Constructor (a, b)

tests/syntax_tests/data/printer/expr/binary.res

@@ -55,6 +55,9 @@ x + y / z
 x / y + z
 x % y * z
 x ^ y + z
+x << y + z
+x >> y + z
+x >>> y + z
 100 * x / total
 2 / 3 * 10 / 2 + 2
 let rotateX = ((range / rect.height) * refY - range / 2) * getXMultiplication(rect.width)