Fix error when parsing let x=-.1; and co.

formatTest/unit_tests/expected_output/infix.re

@@ -1197,3 +1197,7 @@ let (/>/>) = (a, b) => a + b;
 let (><) = (a, b) => a + b;
 
 let x = a >< b;
+
+let (=-) = (a, b) => a + b;
+
+let foo = (a, b) => a =- b;

formatTest/unit_tests/expected_output/syntax.re

@@ -1322,3 +1322,25 @@ let () = x |> Bigarray.Array1.get(_, 1);
 let () = x |> Bigarray.Array2.get(_, 1, 2);
 
 let () = x |> Bigarray.Array3.get(_, 1, 2, 3);
+
+let x = -. 1;
+
+let x = (-1);
+
+let x = 1;
+
+let x = +. 1;
+
+let x = (~a: int=(-1)) => a;
+
+let x = (~a=(-1)) => a;
+
+let x: float = -. 1;
+
+let x: int = (-1);
+
+let x: int = 1;
+
+let x: float = +. 1;
+
+foo(~a=?-1);

formatTest/unit_tests/input/infix.re

@@ -914,3 +914,7 @@ let (/>/>) = (a, b) => a + b;
 let (><) = (a, b) => a + b;
 
 let x = a >< b;
+
+let (=-) = (a, b) => a + b;
+
+let foo = (a, b) => a =- b;

formatTest/unit_tests/input/syntax.re

@@ -1148,3 +1148,25 @@ let () = x |> Bigarray.Array1.get(_, 1);
 let () = x |> Bigarray.Array2.get(_, 1, 2);
 
 let () = x |> Bigarray.Array3.get(_, 1, 2, 3);
+
+let x=-.1;
+
+let x=-1;
+
+let x=+1;
+
+let x=+.1;
+
+let x = (~a: int=- 1) => a;
+
+let x = (~a=-1) => a;
+
+let x: float=-.1;
+
+let x: int =-1;
+
+let x: int=+1;
+
+let x: float =+. 1;
+
+foo(~a=?-1);

src/reason-parser/reason_lexer.mll

@@ -353,18 +353,6 @@ let () =
           None
     )
 
-(* To "unlex" a few characters *)
-let set_lexeme_length buf n = (
-  let open Lexing in
-  if n < 0 then
-    invalid_arg "set_lexeme_length: offset should be positive";
-  if n > buf.lex_curr_pos - buf.lex_start_pos then
-    invalid_arg "set_lexeme_length: offset larger than lexeme";
-  buf.lex_curr_pos <- buf.lex_start_pos + n;
-  buf.lex_curr_p <- {buf.lex_start_p
-                     with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos};
-)
-
 }
 
 
@@ -439,9 +427,6 @@ rule token = parse
         with Not_found -> LIDENT s }
   | lowercase_latin1 identchar_latin1 *
       { warn_latin1 lexbuf; LIDENT (Lexing.lexeme lexbuf) }
-  | "~" lowercase identchar * "="
-      { let l = Lexing.lexeme lexbuf in
-        LABEL_WITH_EQUAL(String.sub l 1 (String.length l - 2)) }
   | uppercase identchar *
       { UIDENT(Lexing.lexeme lexbuf) }       (* No capitalized keywords *)
   | uppercase_latin1 identchar_latin1 *
@@ -607,8 +592,14 @@ rule token = parse
   | "<..>" { LESSDOTDOTGREATER }
   | '\\'? ['~' '?' '!'] operator_chars+
             { PREFIXOP(lexeme_operator lexbuf) }
-  | '\\'? ['=' '<' '>' '|' '&' '$'] operator_chars*
-            { INFIXOP0(lexeme_operator lexbuf) }
+  | '\\'? ['<' '>' '|' '&' '$'] operator_chars*
+            {
+              INFIXOP0(lexeme_operator lexbuf)
+            }
+  | "\\=" operator_chars*
+      { INFIXOP0(lexeme_operator lexbuf) }
+  | '=' operator_chars+
+      { INFIXOP_WITH_EQUAL(lexeme_operator lexbuf) }
   | '\\'? '@' operator_chars*
             { INFIXOP1(lexeme_operator lexbuf) }
   | '\\'? '^' ('\\' '.')? operator_chars*

src/reason-parser/reason_parser.mly

@@ -1036,6 +1036,12 @@ let raise_record_trailing_semi_error loc =
   let msg = "Record entries are separated by comma; we've found a semicolon instead." in
   raise Reason_syntax_util.(Error(loc, (Syntax_error msg)))
 
+let parse_infix_with_eql {txt; loc} expr =
+  let s = (String.sub txt 1 (String.length txt - 1)) in
+  match s with
+  | "-" | "-." -> mkuminus (mkloc s loc) expr
+  | _ -> mkuplus (mkloc s loc) expr
+
 %}
 
 
@@ -1085,6 +1091,7 @@ let raise_record_trailing_semi_error loc =
 %token IN
 %token INCLUDE
 %token <string> INFIXOP0
+%token <string> INFIXOP_WITH_EQUAL
 %token <string> INFIXOP1
 %token <string> INFIXOP2
 %token <string> INFIXOP3
@@ -1094,7 +1101,6 @@ let raise_record_trailing_semi_error loc =
 %token INHERIT
 %token INITIALIZER
 %token <string * char option> INT
-%token <string> LABEL_WITH_EQUAL
 %token LAZY
 %token LBRACE
 %token LBRACELESS
@@ -1201,7 +1207,7 @@ conflicts.
 
 %right    OR BARBAR                     (* expr (e || e || e) *)
 %right    AMPERSAND AMPERAMPER          (* expr (e && e && e) *)
-%left     INFIXOP0 LESS GREATER         (* expr (e OP e OP e) *)
+%left     INFIXOP0 INFIXOP_WITH_EQUAL LESS GREATER (* expr (e OP e OP e) *)
 %left     LESSDOTDOTGREATER (* expr (e OP e OP e) *)
 %right    INFIXOP1                      (* expr (e OP e OP e) *)
 %right    COLONCOLON                    (* expr (e :: e :: e) *)
@@ -2502,14 +2508,10 @@ as_loc
     { Term (Labelled $2.txt, None, $3 $2) }
   | TILDE as_loc(LIDENT) labeled_pattern_constraint EQUAL expr
     { Term (Optional $2.txt, Some $5, $3 $2) }
+  | TILDE as_loc(LIDENT) labeled_pattern_constraint as_loc(INFIXOP_WITH_EQUAL) expr
+    { Term (Optional $2.txt, Some (parse_infix_with_eql $4 $5), $3 $2) }
   | TILDE as_loc(LIDENT) labeled_pattern_constraint EQUAL QUESTION
     { Term (Optional $2.txt, None, $3 $2) }
-  | as_loc(LABEL_WITH_EQUAL) expr
-    { let loc = (mklocation $symbolstartpos $endpos) in
-      Term (Optional $1.txt, Some $2, pat_of_label (mkloc (Longident.parse $1.txt) loc)) }
-  | as_loc(LABEL_WITH_EQUAL) QUESTION
-    { let loc = (mklocation $symbolstartpos $endpos) in
-      Term (Optional $1.txt, None, pat_of_label (mkloc (Longident.parse $1.txt) loc)) } (* mkpat(Ppat_alias) *)
   | pattern_optional_constraint
     { Term (Nolabel, None, $1) }
   | TYPE LIDENT
@@ -3152,23 +3154,26 @@ labeled_expr:
     { (* foo(:bar=?Some(1)) or add(:x=1, :y=2) -> parses :bar=?Some(1) & :x=1 & :y=1 *)
       ($4 (String.concat "" (Longident.flatten $2.txt)), $5 $2)
     }
-  | as_loc(LABEL_WITH_EQUAL) optional labeled_expr_constraint
-    {
-      let loc = (mklocation $symbolstartpos $endpos) in
-      ($2 $1.txt, $3 (mkloc (Longident.parse $1.txt) loc))
+  | TILDE as_loc(val_longident) as_loc(INFIXOP_WITH_EQUAL) labeled_expr_constraint
+    { (* foo(:bar=?Some(1)) or add(:x=1, :y=2) -> parses :bar=?Some(1) & :x=1 & :y=1 *)
+      let infix_op = $3.txt in
+      (* catch optionals e.g. foo(~a=?-1);
+         because we're using `INFIXOP_WITH_EQUAL` to catch all operator chars
+         after the equals sign, we can't match this case with the `optional`
+         rule as above.
+         `infix_op` can bef "=?-" for instance. *)
+      if String.get infix_op 1 == '?' then
+        let infix_loc = { $3 with txt = "=" ^ (String.sub infix_op 2 (String.length infix_op - 2))} in
+        (Optional (String.concat "" (Longident.flatten $2.txt)), parse_infix_with_eql infix_loc ($4 $2))
+      else
+        (Labelled (String.concat "" (Longident.flatten $2.txt)), parse_infix_with_eql $3 ($4 $2))
     }
   | TILDE as_loc(val_longident) EQUAL optional as_loc(UNDERSCORE)
     { (* foo(~l =_) *)
       let loc = $5.loc in
       let exp = mkexp (Pexp_ident (mkloc (Lident "_") loc)) ~loc in
       ($4 (String.concat "" (Longident.flatten $2.txt)), exp)
     }
-  | as_loc(LABEL_WITH_EQUAL) optional as_loc(UNDERSCORE)
-    { (* foo(~l=_) *)
-      let loc = $3.loc in
-      let exp = mkexp (Pexp_ident (mkloc (Lident "_") loc)) ~loc in
-      ($2 $1.txt, exp)
-    }
   | as_loc(UNDERSCORE)
     { (* foo(_) *)
       let loc = $1.loc in
@@ -3202,6 +3207,9 @@ let_binding_body:
   | simple_pattern_ident type_constraint EQUAL expr
     { let loc = mklocation $symbolstartpos $endpos in
       ($1, ghexp_constraint loc $4 $2) }
+  | simple_pattern_ident type_constraint as_loc(INFIXOP_WITH_EQUAL) expr
+    { let loc = mklocation $symbolstartpos $endpos in
+      ($1, ghexp_constraint loc (parse_infix_with_eql $3 $4) $2) }
   | simple_pattern_ident fun_def(EQUAL,core_type)
     { ($1, $2) }
   | simple_pattern_ident COLON preceded(QUOTE,ident)+ DOT core_type
@@ -3276,6 +3284,8 @@ let_binding_body:
    *)
   | pattern EQUAL expr
     { ($1, $3) }
+  | pattern as_loc(INFIXOP_WITH_EQUAL) expr
+    { ($1, parse_infix_with_eql $2 $3) }
   | simple_pattern_not_ident COLON core_type EQUAL expr
     { let loc = mklocation $symbolstartpos $endpos in
       (mkpat ~loc (Ppat_constraint($1, $3)), $5)
@@ -4400,6 +4410,7 @@ val_ident:
 
 %inline infix_operator:
   | INFIXOP0          { $1 }
+  | INFIXOP_WITH_EQUAL { $1 }
   | INFIXOP1          { $1 }
   | INFIXOP2          { $1 }
   | INFIXOP3          { $1 }