diff --git a/lib/error.ml b/lib/error.ml index 2c62403..b4f912f 100644 --- a/lib/error.ml +++ b/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 diff --git a/lib/interpreter.ml b/lib/interpreter.ml index a68815d..c074fc8 100644 --- a/lib/interpreter.ml +++ b/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)) - | Not, Bool b -> Ok (Bool (not b)) + | Neg, Number x -> Number (-.x) |> Result.ok + | 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)) - | Number x, Plus, Number y -> Ok (Number (x +. y)) - | Number x, Minus, Number y -> Ok (Number (x -. y)) - | Number x, Mul, Number y -> Ok (Number (x *. y)) + | String a, Plus, String b -> String (a ^ b) |> Result.ok + | Number x, Plus, Number y -> Number (x +. y) |> Result.ok + | Number x, Minus, Number y -> Number (x -. y) |> Result.ok + | 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 } - | Bool b, And, Bool c -> Ok (Bool (b && c)) - | Bool b, Or, Bool c -> Ok (Bool (b || c)) + RuntimeError.make pos msg |> Result.error + | Bool b, And, Bool c -> Bool (b && c) |> Result.ok + | 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, GreaterEqual, Number y -> Ok (Bool (x >= y)) - | Number x, Less, Number y -> Ok (Bool (x < y)) - | Number x, LessEqual, Number y -> Ok (Bool (x <= y)) - | String a, Greater, String b -> Ok (Bool (a > b)) - | String a, GreaterEqual, String b -> Ok (Bool (a >= b)) - | String a, Less, String b -> Ok (Bool (a < b)) - | String a, LessEqual, String b -> Ok (Bool (a <= b)) + | Number x, Greater, Number y -> Bool (x > y) |> Result.ok + | Number x, GreaterEqual, Number y -> Bool (x >= y) |> Result.ok + | Number x, Less, Number y -> Bool (x < y) |> Result.ok + | Number x, LessEqual, Number y -> Bool (x <= y) |> Result.ok + | String a, Greater, String b -> Bool (a > b) |> Result.ok + | String a, GreaterEqual, String b -> Bool (a >= b) |> Result.ok + | String a, Less, String b -> Bool (a < b) |> Result.ok + | 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 - interpret_stmt env stmt_node + let result = interpret_stmt env body in + match result with + | Error { is_break = true; _ } -> Ok () + | Error e -> Error e + | _ -> interpret_stmt env stmt_node else Ok () diff --git a/lib/lexer.ml b/lib/lexer.ml index c6cf3b7..0a4134b 100644 --- a/lib/lexer.ml +++ b/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 - |> insert "for" For |> insert "fun" Fun |> insert "if" If |> insert "nil" Nil |> insert "or" Or - |> insert "print" Print |> insert "return" Return |> insert "super" Super |> insert "this" This - |> insert "true" True |> insert "var" Var |> insert "while" While + keywords |> insert "and" And |> insert "break" Break |> insert "class" Class |> insert "else" Else + |> insert "false" False |> insert "for" For |> insert "fun" Fun |> insert "if" If + |> insert "nil" Nil |> insert "or" Or |> insert "print" Print |> insert "return" Return + |> insert "super" Super |> insert "this" This |> insert "true" True |> insert "var" Var + |> insert "while" While type token = { token_type : token_type; pos : code_pos } diff --git a/lib/lexer.mli b/lib/lexer.mli index 0cdbd71..07b3d8e 100644 --- a/lib/lexer.mli +++ b/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 diff --git a/lib/parser.ml b/lib/parser.ml index 9ecf72f..53d51c2 100644 --- a/lib/parser.ml +++ b/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 diff --git a/lib/stmt.ml b/lib/stmt.ml index 9ebeba0..59d398a 100644 --- a/lib/stmt.ml +++ b/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