implemented break

lib/error.ml

@@ -21,12 +21,17 @@ module ParserError = struct
     Printf.printf "ParserError at line %d, column %d: %s\n" e.pos.line e.pos.col e.msg
 end
 
-type runtime_error = { pos : code_pos; msg : string }
+type runtime_error = { pos : code_pos; msg : string; is_break : bool }
 
 module RuntimeError = struct
   type t = parser_error
 
-  let make (pos : code_pos) (msg : string) : runtime_error = { pos; msg }
+  let make (pos : code_pos) (msg : string) : runtime_error = { pos; msg; is_break = false }
+
+  let break () : runtime_error =
+    let pos = { line = -1; col = -1 } in
+    let msg = "" in
+    { pos; msg; is_break = true }
 
   let print (e : runtime_error) =
     Printf.printf "RuntimeError at line %d, column %d: %s\n" e.pos.line e.pos.col e.msg

lib/interpreter.ml

@@ -13,18 +13,18 @@ let rec interpret_expr (env : environment) (expr_node : expr_node) :
     (lox_value, runtime_error) result =
   let { pos; expr } = expr_node in
   match expr with
-  | Literal literal -> Ok (value_of_literal literal)
+  | Literal literal -> value_of_literal literal |> Result.ok
   | Variable name -> (
       let value_opt = Env.get env name in
       match value_opt with
       | Some x -> Ok x
       | None ->
           let msg = Printf.sprintf "name \"%s\" is not defined" name in
-          Error (RuntimeError.make pos msg))
+          RuntimeError.make pos msg |> Result.error)
   | Assignment { name; expr } ->
       if not (Env.is_defined env name) then
         let msg = Printf.sprintf "tried to assign to undefined variable %s" name in
-        Error (RuntimeError.make pos msg)
+        RuntimeError.make pos msg |> Result.error
       else
         let* value = interpret_expr env expr in
         Env.update env name value;
@@ -32,44 +32,44 @@ let rec interpret_expr (env : environment) (expr_node : expr_node) :
   | Unary { op; expr } -> (
       let* expr = interpret_expr env expr in
       match (op, expr) with
-      | Neg, Number x -> Ok (Number (-.x))
+      | Neg, Number x -> Number (-.x) |> Result.ok
-      | Not, Bool b -> Ok (Bool (not b))
+      | Not, Bool b -> Bool (not b) |> Result.ok
       | _, _ ->
           let msg =
             Printf.sprintf "Invalid operant of type %s to operator %s"
               (type_string_of_lox_value expr) (show_unary_op op)
           in
-          Error (RuntimeError.make pos msg))
+          RuntimeError.make pos msg |> Result.error)
   | Binary { op; left; right } -> (
       let* left = interpret_expr env left in
       let* right = interpret_expr env right in
       match (left, op, right) with
-      | String a, Plus, String b -> Ok (String (a ^ b))
+      | String a, Plus, String b -> String (a ^ b) |> Result.ok
-      | Number x, Plus, Number y -> Ok (Number (x +. y))
+      | Number x, Plus, Number y -> Number (x +. y) |> Result.ok
-      | Number x, Minus, Number y -> Ok (Number (x -. y))
+      | Number x, Minus, Number y -> Number (x -. y) |> Result.ok
-      | Number x, Mul, Number y -> Ok (Number (x *. y))
+      | Number x, Mul, Number y -> Number (x *. y) |> Result.ok
       | Number x, Div, Number y ->
-          if y <> 0. then Ok (Number (x /. y))
+          if y <> 0. then Number (x /. y) |> Result.ok
           else
             let msg = "Division by 0" in
-            Error { pos; msg }
+            RuntimeError.make pos msg |> Result.error
-      | Bool b, And, Bool c -> Ok (Bool (b && c))
+      | Bool b, And, Bool c -> Bool (b && c) |> Result.ok
-      | Bool b, Or, Bool c -> Ok (Bool (b || c))
+      | Bool b, Or, Bool c -> Bool (b || c) |> Result.ok
       | _, Equal, _ -> Ok (Bool (left = right))
-      | Number x, Greater, Number y -> Ok (Bool (x > y))
+      | Number x, Greater, Number y -> Bool (x > y) |> Result.ok
-      | Number x, GreaterEqual, Number y -> Ok (Bool (x >= y))
+      | Number x, GreaterEqual, Number y -> Bool (x >= y) |> Result.ok
-      | Number x, Less, Number y -> Ok (Bool (x < y))
+      | Number x, Less, Number y -> Bool (x < y) |> Result.ok
-      | Number x, LessEqual, Number y -> Ok (Bool (x <= y))
+      | Number x, LessEqual, Number y -> Bool (x <= y) |> Result.ok
-      | String a, Greater, String b -> Ok (Bool (a > b))
+      | String a, Greater, String b -> Bool (a > b) |> Result.ok
-      | String a, GreaterEqual, String b -> Ok (Bool (a >= b))
+      | String a, GreaterEqual, String b -> Bool (a >= b) |> Result.ok
-      | String a, Less, String b -> Ok (Bool (a < b))
+      | String a, Less, String b -> Bool (a < b) |> Result.ok
-      | String a, LessEqual, String b -> Ok (Bool (a <= b))
+      | String a, LessEqual, String b -> Bool (a <= b) |> Result.ok
       | _, _, _ ->
           let msg =
             Printf.sprintf "Invalid operands of type %s and %s to operator %s"
               (type_string_of_lox_value left) (type_string_of_lox_value right) (show_binary_op op)
           in
-          Error { pos; msg })
+          RuntimeError.make pos msg |> Result.error)
   | Logical { op; left; right } -> (
       let* left = interpret_expr env left in
       match (op, lox_value_to_bool left) with
@@ -83,6 +83,10 @@ let rec interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runt
   | Expr expr ->
       let* _ = interpret_expr env expr in
       Ok ()
+  | Break ->
+      (* print_endline "break!";
+         Ok () (* TODO *) *)
+      RuntimeError.break () |> Result.error
   | Print expr ->
       let* value = interpret_expr env expr in
       print_endline (Value.string_of_lox_value value);
@@ -93,7 +97,7 @@ let rec interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runt
       if success then Ok ()
       else
         let msg = Printf.sprintf "Tried to define %s, but was already defined" name in
-        Error (RuntimeError.make pos msg)
+        RuntimeError.make pos msg |> Result.error
   | Block stmts ->
       let env = Env.enter env in
       let rec _interpret stmts =
@@ -113,6 +117,9 @@ let rec interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runt
       let* cond = interpret_expr env cond in
       let cond = lox_value_to_bool cond in
       if cond then
-        let* _ = interpret_stmt env body in
+        let result = interpret_stmt env body in
-        interpret_stmt env stmt_node
+        match result with
+        | Error { is_break = true; _ } -> Ok ()
+        | Error e -> Error e
+        | _ -> interpret_stmt env stmt_node
       else Ok ()

lib/lexer.ml

@@ -14,7 +14,7 @@ open Error
   | String of string
   | Number of float
 
-  | And | Class | Else | False | Fun | For | If | Nil | Or | Print | Return | Super | This | True
+  | And | Break | Class | Else | False | Fun | For | If | Nil | Or | Print | Return | Super | This | True
   | Var | While
 
   | Comment of string
@@ -29,10 +29,11 @@ let keywords =
     Hashtbl.add keywords s tt;
     keywords
   in
-  keywords |> insert "and" And |> insert "class" Class |> insert "else" Else |> insert "false" False
+  keywords |> insert "and" And |> insert "break" Break |> insert "class" Class |> insert "else" Else
-  |> insert "for" For |> insert "fun" Fun |> insert "if" If |> insert "nil" Nil |> insert "or" Or
+  |> insert "false" False |> insert "for" For |> insert "fun" Fun |> insert "if" If
-  |> insert "print" Print |> insert "return" Return |> insert "super" Super |> insert "this" This
+  |> insert "nil" Nil |> insert "or" Or |> insert "print" Print |> insert "return" Return
-  |> insert "true" True |> insert "var" Var |> insert "while" While
+  |> insert "super" Super |> insert "this" This |> insert "true" True |> insert "var" Var
+  |> insert "while" While
 
 type token = { token_type : token_type; pos : code_pos }
 

lib/lexer.mli

@@ -22,6 +22,7 @@ type token_type =
   | String of string
   | Number of float
   | And
+  | Break
   | Class
   | Else
   | False
@@ -50,36 +51,4 @@ val show_token : token -> string
 
 type lexer_result = (token list, Error.lexer_error list) result
 
-(* type state = {
-        source : string;
-        start_pos : int;
-        cur_pos : int;
-        tokens_rev : token list;
-        errors_rev : Error.lexer_error list;
-        line : int;
-        col : int;
-      }
-   module State : sig
-     type t = state
-
-     val is_digit : char -> bool
-     val is_alpha : char -> bool
-     val is_alphanum : char -> bool
-     val is_identifier : char -> bool
-     val is_at_end : state -> bool
-     val get_lexeme : state -> int -> int -> string
-     val advance : state -> char * state
-     val peek : state -> char option
-     val advance_if : char -> state -> bool * state
-     val advance_until : char -> state -> bool * state
-     val advance_while : (char -> bool) -> state -> state
-     val last_char : state -> char
-     val append_token : Error.code_pos -> token_type -> state -> state
-     val append_error : Error.code_pos -> string -> state -> state
-     val parse_number : state -> state
-     val parse_keyword_or_identifier : state -> state
-     val parse_block_commend : state -> state
-     val tokenize_rec : state -> state
-   end *)
-
 val tokenize : string -> lexer_result

lib/parser.ml

@@ -8,10 +8,18 @@ open Stmt
 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 }
+type state = { tokens : token list; is_in_loop : bool }
 
+let with_is_in_loop (f : state ref -> stmt_result) (state : state ref) : stmt_result =
+  let was_in_loop = !state.is_in_loop in
+  state := { !state with is_in_loop = true };
+  let result = f state in
+  state := { !state with is_in_loop = was_in_loop };
+  result
+
+let make_state tokens = ref { tokens; is_in_loop = false }
 let is_at_end state = (List.hd !state.tokens).token_type = Eof
-let advance state = state := { tokens = List.tl !state.tokens }
+let advance state = state := { !state with tokens = List.tl !state.tokens }
 
 let next state =
   assert (not ((List.hd !state.tokens).token_type = Eof));
@@ -257,7 +265,12 @@ and while_loop (state : state ref) : stmt_result =
   let* _ = consume state LeftParen in
   let* cond = expression state in
   let* _ = consume state RightParen in
-  let* body = statement state in
+  (* let was_in_loop = !state.is_in_loop in
+        state := { !state with is_in_loop = true };
+        let body = statement state in
+        state := { !state with is_in_loop = was_in_loop };
+     let* body = body in *)
+  let* body = with_is_in_loop statement state in
   make_while pos cond body |> Result.ok
 
 and for_loop (state : state ref) : stmt_result =
@@ -287,7 +300,12 @@ and for_loop (state : state ref) : stmt_result =
     | _ -> expression state |> Result.map Option.some
   in
   let* _ = consume state RightParen in
-  let* body = statement state in
+  (* let was_in_loop = !state.is_in_loop in
+     state := { !state with is_in_loop = true };
+     let body = statement state in
+     state := { !state with is_in_loop = was_in_loop };
+     let* body = body in *)
+  let* body = with_is_in_loop statement state in
   let body =
     match update with
     | Some update ->
@@ -311,6 +329,14 @@ and expr_stmt (state : state ref) : stmt_result =
 and statement (state : state ref) : stmt_result =
   let pos = cur_pos state in
   match peek_tt state with
+  | Break ->
+      if !state.is_in_loop then (
+        advance state;
+        let* _ = consume state Semicolon in
+        make_break pos |> Result.ok)
+      else
+        let msg = "Can use break only in loops" in
+        ParserError.make pos msg |> Result.error
   | Print ->
       advance state;
       let* expr = expression state in
@@ -371,5 +397,5 @@ let parse (tokens : token list) : parse_result =
   let tokens =
     List.filter (fun tok -> match tok.token_type with Comment _ -> false | _ -> true) tokens
   in
-  let state = ref { tokens } in
+  let state = make_state tokens in
   parse_impl state

lib/stmt.ml

@@ -2,6 +2,7 @@ open Expr
 
 type stmt =
   | Expr of expr_node
+  | Break
   | Print of expr_node
   | VarDecl of { name : string; init : expr_node option }
   | Block of stmt_node list
@@ -16,6 +17,7 @@ let rec show_stmt ?(indent = 0) stmt =
   let show_stmt_ind ?(add = 2) = show_stmt ~indent:(indent + add) in
   match stmt with
   | Expr expr -> indent_s ^ "Expr\n" ^ show_expr_ind expr.expr
+  | Break -> indent_s ^ "Break"
   | Print expr -> indent_s ^ "Print\n" ^ show_expr_ind expr.expr
   | VarDecl { name; init } -> (
       indent_s ^ "Var " ^ name
@@ -26,10 +28,10 @@ let rec show_stmt ?(indent = 0) stmt =
       in
       indent_s ^ "Block\n" ^ stmts_s ^ indent_s ^ "End"
   | If { cond; then_; else_ } ->
-      let cond_s = show_expr_ind cond.expr in
+      let cond_s = show_expr_ind ~add:4 cond.expr in
       let then_s = show_stmt_ind ~add:4 then_.stmt in
       let else_s = Option.map (fun stmt -> show_stmt_ind ~add:4 stmt.stmt) else_ in
-      indent_s ^ "If\n" ^ indent_s ^ "  Cond" ^ cond_s ^ "\n" ^ indent_s ^ "  Then\n" ^ then_s
+      indent_s ^ "If\n" ^ indent_s ^ "  Cond\n" ^ cond_s ^ "\n" ^ indent_s ^ "  Then\n" ^ then_s
       ^ if Option.is_some else_s then "\n" ^ indent_s ^ "  Else\n" ^ Option.get else_s else ""
   | While { cond; body } ->
       let cond_s = show_expr_ind ~add:4 cond.expr in
@@ -42,6 +44,8 @@ let make_stmt_node (pos : Error.code_pos) (stmt : stmt) : stmt_node = { stmt; po
 let make_expr_stmt (pos : Error.code_pos) (expr : expr_node) : stmt_node =
   Expr expr |> make_stmt_node pos
 
+let make_break (pos : Error.code_pos) : stmt_node = Break |> make_stmt_node pos
+
 let make_print (pos : Error.code_pos) (expr : expr_node) : stmt_node =
   Print expr |> make_stmt_node pos