started implementing expressions

Parser.parse now return list of statements or list of errors.
parsing continues until EOF, even when errors are found; but after the
first error the result can only be Error.
Also implemented Print and Expr statements.

lib/parser.ml

@@ -3,8 +3,10 @@ let ( let* ) = Result.bind
 open Error
 open Expr
 open Lexer
+open Stmt
 
-type parse_result = (expr_node, parser_error list) result
+type parse_result = (stmt_node list, parser_error list) result
+type stmt_result = (stmt_node, parser_error) result
 type expr_result = (expr_node, parser_error) result
 type state = { tokens : token list; errors_rev : parser_error list }
 
@@ -16,6 +18,8 @@ let append_error msg pos state =
 
 let advance state = state := { !state with tokens = List.tl !state.tokens }
 let peek state = List.hd !state.tokens
+let peek_tt (state : state ref) : token_type = (peek state).token_type
+let cur_pos state = (peek state).pos
 
 let next state =
   assert (not ((List.hd !state.tokens).token_type == Eof));
@@ -24,16 +28,22 @@ let next state =
   token
 
 let advance_if state tt =
-  if (peek state).token_type == tt then (
+  if peek_tt state == tt then (
     advance state;
     true)
   else false
 
-let matches state tts =
-  let f = ( == ) (peek state).token_type in
-  Array.fold_left (fun acc tt -> acc || f tt) false tts
+let consume state tt =
+  if advance_if state tt then Ok ()
+  else
+    Error
+      (ParserError.make (cur_pos state)
+         (Printf.sprintf "Expected %s, but got %s" (show_token_type tt)
+            (show_token_type (peek_tt state))))
 
-let cur_pos state = (peek state).pos
+let matches state tts =
+  let f = ( == ) (peek_tt state) in
+  Array.fold_left (fun acc tt -> acc || f tt) false tts
 
 let collect_chain (state : state ref) (tts : token_type array)
     (higher_prec : state ref -> expr_result) : ((expr_node * token) array, parser_error) result =
@@ -49,7 +59,7 @@ let collect_chain (state : state ref) (tts : token_type array)
 
 let primary (state : state ref) : expr_result =
   let pos = cur_pos state in
-  match (peek state).token_type with
+  match peek_tt state with
   | Number x ->
       advance state;
       Ok (make_number pos x)
@@ -77,7 +87,7 @@ let rec grouping (state : state ref) : expr_result =
     if advance_if state RightParen then Ok expr (* expect a ) here *)
     else
       let pos = cur_pos state in
-      let tt = (peek state).token_type in
+      let tt = peek_tt state in
       let msg = Printf.sprintf "Expected RightParen, got %s instead" (show_token_type tt) in
       Error { pos; msg })
   else primary state
@@ -100,7 +110,7 @@ and neg_not (state : state ref) : expr_result =
 and mul_or_div (state : state ref) : expr_result =
   let* expr = neg_not state in
   let* exprs_tokens = collect_chain state [| Star; Slash |] neg_not in
-  let f acc (expr, token) =
+  let f acc (expr, (token : token)) =
     let pos = token.pos in
     let op : binary_op =
       match token.token_type with
@@ -116,7 +126,7 @@ and mul_or_div (state : state ref) : expr_result =
 and sum_or_diff (state : state ref) : expr_result =
   let* expr = mul_or_div state in
   let* exprs_tokens = collect_chain state [| Plus; Minus |] mul_or_div in
-  let f acc (expr, token) =
+  let f acc (expr, (token : token)) =
     let pos = token.pos in
     let op : binary_op =
       match token.token_type with
@@ -135,7 +145,7 @@ and inequality (state : state ref) : expr_result =
   let* exprs_tokens =
     collect_chain state [| Greater; GreaterEqual; Less; LessEqual |] sum_or_diff
   in
-  let f acc (expr, token) =
+  let f acc (expr, (token : token)) =
     let pos = token.pos in
     let (op : binary_op) =
       match token.token_type with
@@ -153,7 +163,7 @@ and inequality (state : state ref) : expr_result =
 and equality (state : state ref) : expr_result =
   let* expr = inequality state in
   let* exprs_tokens = collect_chain state [| EqualEqual; BangEqual |] inequality in
-  let f acc (expr, token) =
+  let f acc (expr, (token : token)) =
     let pos = token.pos in
     match token.token_type with
     | EqualEqual -> make_binary pos Equal acc expr
@@ -167,26 +177,40 @@ and equality (state : state ref) : expr_result =
 
 and expression (state : state ref) : expr_result = equality state
 
+let statement (state : state ref) : stmt_result =
+  let pos = cur_pos state in
+  match peek_tt state with
+  | Print ->
+      advance state;
+      let* expr = expression state in
+      let* _ = consume state Semicolon in
+      let stmt = make_print pos expr in
+      Ok stmt
+  | tt ->
+      let msg =
+        Printf.sprintf "Statement stating with %s not yet implemented" (show_token_type tt)
+      in
+      Error (ParserError.make pos msg)
+
 let rec synchronise (state : state ref) =
-  match (peek state).token_type with
+  match peek_tt state with
   | Semicolon -> advance state
   | Class | Fun | Var | For | If | While | Print | Return | Eof -> ()
   | _ ->
       advance state;
       synchronise state
 
-let parse (tokens : token list) : parse_result =
+let rec parse (tokens : token list) : parse_result =
   let state = ref { tokens; errors_rev = [] } in
-  let result = expression state |> Result.map_error (fun e -> [ e ]) in
-  assert (Result.is_error result || (peek state).token_type = Eof);
-  result
-(* let expr = State.expression state in
-   let state =
-     if not (State.is_at_end state) then
-       let tt = (State.peek state).token_type in
-       let msg = Printf.sprintf "Unexpected %s at end" (show_token_type tt) in
-       State.append_error msg (State.peek state).pos state
-     else state
-   in
-   (* if List.length state.errors_rev != 0 then Ok expr else Error (List.rev state.errors_rev) *)
-   match state.errors_rev with [] -> Ok expr | es -> Error (List.rev es) *)
+  let result = statement state in
+  match result with
+  | Ok stmt when peek_tt state == Eof -> Ok [ stmt ]
+  | Ok stmt ->
+      let* stmts = parse !state.tokens in
+      Ok (stmt :: stmts)
+  | Error e -> (
+      synchronise state;
+      if peek_tt state == Eof then Error [ e ]
+      else
+        let tail_result = parse !state.tokens in
+        match tail_result with Ok _ -> Error [ e ] | Error es -> Error (e :: es))