Fix unary minus parsing

.github/workflows/ci.yml

@@ -55,7 +55,7 @@ jobs:
       - name: Install dependencies
         run: |
           opam install . --deps-only --with-test -y
-          opam install ocamlformat -y
+          opam install ocamlformat.0.28.1 -y
 
       - name: Check formatting
         run: |

lib/lexer.ml

@@ -132,9 +132,6 @@ module Lexer = struct
             | Some '>' ->
                 let _ = get lexer in
                 ARROW
-            | Some d when d >= '0' && d <= '9' ->
-                let n = read_int lexer in
-                INT (-n)
             | _ -> MINUS)
         | c when c >= '0' && c <= '9' ->
             let n = Char.code c - Char.code '0' in

lib/parser.ml

@@ -168,33 +168,30 @@ module Parser = struct
     | _ -> e
 
   and parse_add parser =
-    let e = parse_mul parser in
-    match parser.current_token with
-    | PLUS ->
-        next parser;
-        BinOp (Add, e, parse_add parser)
-    | MINUS ->
-        next parser;
-        BinOp (Sub, e, parse_add parser)
-    | _ -> e
+    let rec loop left =
+      match parser.current_token with
+      | PLUS ->
+          next parser;
+          loop (BinOp (Add, left, parse_mul parser))
+      | MINUS ->
+          next parser;
+          loop (BinOp (Sub, left, parse_mul parser))
+      | _ -> left
+    in
+    loop (parse_mul parser)
 
   and parse_mul parser =
-    let e = parse_unop parser in
-    match parser.current_token with
-    | STAR ->
-        next parser;
-        BinOp (Mul, e, parse_mul parser)
-    | SLASH ->
-        next parser;
-        BinOp (Div, e, parse_mul parser)
-    | _ -> e
-
-  and parse_unop parser =
-    match parser.current_token with
-    | MINUS ->
-        next parser;
-        UnOp (Neg, parse_unop parser)
-    | _ -> parse_unary parser
+    let rec loop left =
+      match parser.current_token with
+      | STAR ->
+          next parser;
+          loop (BinOp (Mul, left, parse_unary parser))
+      | SLASH ->
+          next parser;
+          loop (BinOp (Div, left, parse_unary parser))
+      | _ -> left
+    in
+    loop (parse_unary parser)
 
   and parse_unary parser =
     match parser.current_token with

lib/parser.mli

@@ -17,7 +17,6 @@ module Parser : sig
   val parse_rel : parser -> Ast.expr
   val parse_add : parser -> Ast.expr
   val parse_mul : parser -> Ast.expr
-  val parse_unop : parser -> Ast.expr
   val parse_unary : parser -> Ast.expr
   val parse_app : parser -> Ast.expr
   val parse_atom : parser -> Ast.expr

test/test_MiniML.ml

@@ -155,7 +155,8 @@ let lexer_tests =
             Lexer.Lexer.OR;
             Lexer.Lexer.IDENT "x_1";
             Lexer.Lexer.NEQ;
-            Lexer.Lexer.INT (-42);
+            Lexer.Lexer.MINUS;
+            Lexer.Lexer.INT 42;
             Lexer.Lexer.EOF;
           ]
           (collect_tokens
@@ -266,6 +267,20 @@ let parser_tests =
            ( Ast.Or,
              Ast.UnOp (Ast.Not, Ast.Bool false),
              Ast.BinOp (Ast.And, Ast.Bool true, Ast.Bool false) )) );
+    ( "unary minus binds tighter than addition",
+      `Quick,
+      expect_parse "-1 + 2"
+        (Ast.BinOp (Ast.Add, Ast.UnOp (Ast.Neg, Ast.Int 1), Ast.Int 2)) );
+    ( "subtraction associates left",
+      `Quick,
+      expect_parse "1 - 2 - 3"
+        (Ast.BinOp
+           (Ast.Sub, Ast.BinOp (Ast.Sub, Ast.Int 1, Ast.Int 2), Ast.Int 3)) );
+    ( "division associates left",
+      `Quick,
+      expect_parse "8 / 4 / 2"
+        (Ast.BinOp
+           (Ast.Div, Ast.BinOp (Ast.Div, Ast.Int 8, Ast.Int 4), Ast.Int 2)) );
     ( "trailing token is rejected",
       `Quick,
       expect_parse_failure "1 < 2 < 3" "Unexpected trailing token: LT" );
@@ -304,6 +319,11 @@ let eval_tests =
     ( "integer comparisons",
       `Quick,
       expect_run "1 < 2 && 2 <= 2 && 3 > 2 && 3 >= 3" "true" );
+    ("negative literal plus positive", `Quick, expect_run "-1 + 2" "1");
+    ( "subtraction associates left at runtime",
+      `Quick,
+      expect_run "1 - 2 - 3" "-4" );
+    ("division associates left at runtime", `Quick, expect_run "8 / 4 / 2" "1");
     ("unary minus over arithmetic", `Quick, expect_run "-(1 + 2)" "-3");
     ("not false", `Quick, expect_run "not false" "true");
     ("if false branch", `Quick, expect_run "if false then 1 else 2" "2");