fix(compiler): Fix precedence of >> operator (#1515)

Author: ospencer

compiler/src/parsing/parser.messages

@@ -6969,14 +6969,21 @@ program: BIGINT RCARET RCARET EOL WHEN
 ## In state 3, spurious reduction of production nonempty_list(eol) -> EOL
 ## In state 5, spurious reduction of production eols -> nonempty_list(eol)
 ##
-program: LPAREN INFIX_100 WHILE
+program: BIGINT RCARET RCARET RPAREN
 ##
-## Ends in an error in state: 150.
+## Ends in an error in state: 65.
 ##
-## id_str -> lparen special_op . rparen [ WHEN TYPE THICKARROW STAR SLASH SEMI RPAREN RECORD RCARET RBRACK RBRACE PIPE LPAREN LET LCARET LBRACK INFIX_ASSIGNMENT_10 INFIX_90 INFIX_80 INFIX_70 INFIX_60 INFIX_50 INFIX_40 INFIX_30 INFIX_120 INFIX_110 INFIX_100 IMPORT GETS FROM EXPORT EQUAL EOL EOF ENUM ELSE DOT DASH COMMA COLON AT AS ]
+## binop_expr -> non_stmt_expr rcaret_rcaret_op . non_stmt_expr [ THICKARROW STAR SLASH SEMI RPAREN RCARET RBRACK RBRACE PIPE LCARET INFIX_90 INFIX_80 INFIX_70 INFIX_60 INFIX_50 INFIX_40 INFIX_30 INFIX_120 INFIX_110 INFIX_100 EOL EOF ELSE DASH COMMA COLON ]
+## binop_expr -> non_stmt_expr rcaret_rcaret_op . eols non_stmt_expr [ THICKARROW STAR SLASH SEMI RPAREN RCARET RBRACK RBRACE PIPE LCARET INFIX_90 INFIX_80 INFIX_70 INFIX_60 INFIX_50 INFIX_40 INFIX_30 INFIX_120 INFIX_110 INFIX_100 EOL EOF ELSE DASH COMMA COLON ]
 ##
 ## The known suffix of the stack is as follows:
-## lparen special_op
+## non_stmt_expr rcaret_rcaret_op
+##
+## WARNING: This example involves spurious reductions.
+## This implies that, although the LR(1) items shown above provide an
+## accurate view of the past (what has been recognized so far), they
+## may provide an INCOMPLETE view of the future (what was expected next).
+## In state 70, spurious reduction of production rcaret_rcaret_op -> lnonempty_list_inner(RCARET) RCARET
 ##
 program: LPAREN RCARET WHILE
 ##

compiler/src/parsing/parser.mly

@@ -232,6 +232,7 @@ annotated_expr:
 
 binop_expr:
   | non_stmt_expr infix_op opt_eols non_stmt_expr { Exp.binop ~loc:(to_loc $loc) (mkid_expr $loc($2) [mkstr $loc($2) $2]) [$1; $4] }
+  | non_stmt_expr rcaret_rcaret_op opt_eols non_stmt_expr %prec INFIX_100 { Exp.binop ~loc:(to_loc $loc) (mkid_expr $loc($2) [mkstr $loc($2) $2]) [$1; $4] }
 
 ellipsis_prefix(X):
   | ELLIPSIS X {$2}
@@ -385,6 +386,9 @@ paren_expr:
 app_expr:
   | left_accessor_expr lparen lseparated_list(comma, expr) comma? rparen { Exp.apply ~loc:(to_loc $loc) $1 $3 }
 
+rcaret_rcaret_op:
+  | lnonempty_list(RCARET) RCARET { (String.init (1 + List.length $1) (fun _ -> '>')) }
+
 // These are all inlined to carry over their precedence.
 %inline infix_op:
   | INFIX_30
@@ -402,7 +406,7 @@ app_expr:
   | DASH { "-" }
   | PIPE { "|" }
   | LCARET { "<" }
-  | llist(RCARET) RCARET { (String.init (1 + List.length $1) (fun _ -> '>')) }
+  | RCARET { ">" }
 
 %inline prefix_op:
   | PREFIX_150 {$1}
@@ -413,7 +417,7 @@ primitive_:
   | FAIL { "fail" }
 
 special_op:
-  | infix_op | prefix_op {$1}
+  | infix_op | rcaret_rcaret_op | prefix_op {$1}
 
 %inline special_id:
   | lparen special_op rparen { mkstr $loc($2) $2 }

compiler/test/suites/parsing.re

@@ -186,4 +186,34 @@ describe("parsing", ({test, testSkip}) => {
       prog_loc: Location.dummy_loc,
     },
   );
+  assertParse(
+    "regression_issue_1473",
+    "a << b >> c",
+    {
+      statements: [
+        Top.expr(
+          Exp.apply(
+            Exp.ident(
+              Location.mknoloc(
+                Identifier.IdentName(Location.mknoloc(">>")),
+              ),
+            ),
+            [
+              Exp.apply(
+                Exp.ident(
+                  Location.mknoloc(
+                    Identifier.IdentName(Location.mknoloc("<<")),
+                  ),
+                ),
+                [a, b],
+              ),
+              c,
+            ],
+          ),
+        ),
+      ],
+      comments: [],
+      prog_loc: Location.dummy_loc,
+    },
+  );
 });