diff --git a/lib/error.ml b/lib/error.ml index b4f912f..475030e 100644 --- a/lib/error.ml +++ b/lib/error.ml @@ -21,20 +21,21 @@ 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; is_break : bool } +(* type runtime_error = { pos : code_pos; msg : string; type_ : runtime_error_type } *) +type runtime_error = Error of { pos : code_pos; msg : string } | Break | Continue module RuntimeError = struct type t = parser_error - 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 make (pos : code_pos) (msg : string) : runtime_error = Error { pos; msg } + let break () : runtime_error = Break + let continue () : runtime_error = Continue let print (e : runtime_error) = - Printf.printf "RuntimeError at line %d, column %d: %s\n" e.pos.line e.pos.col e.msg + match e with + | Error { pos; msg } -> + Printf.printf "RuntimeError at line %d, column %d: %s\n" pos.line pos.col msg + | Break | Continue -> assert false end type lox_error = diff --git a/lib/interpreter.ml b/lib/interpreter.ml index c074fc8..f603109 100644 --- a/lib/interpreter.ml +++ b/lib/interpreter.ml @@ -87,6 +87,7 @@ let rec interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runt (* print_endline "break!"; Ok () (* TODO *) *) RuntimeError.break () |> Result.error + | Continue -> RuntimeError.continue () |> Result.error | Print expr -> let* value = interpret_expr env expr in print_endline (Value.string_of_lox_value value); @@ -119,7 +120,31 @@ let rec interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runt if cond then let result = interpret_stmt env body in match result with - | Error { is_break = true; _ } -> Ok () + | Ok () | Error Continue -> interpret_stmt env stmt_node + | Error Break -> Ok () | Error e -> Error e - | _ -> interpret_stmt env stmt_node else Ok () + | For { init; cond; update; body } -> + let* _ = init |> Option.map (interpret_stmt env) |> Option.value ~default:(Ok ()) in + let eval_cond () = + cond + |> Option.map (interpret_expr env) + |> Option.value ~default:(Ok (Value.Bool true)) + |> Result.map Value.lox_value_to_bool + in + let do_update () = + update |> Option.map (interpret_expr env) |> Option.value ~default:(Ok Value.Nil) + in + let rec loop () = + let* cond = eval_cond () in + if cond then + let result = interpret_stmt env body in + match result with + | Ok () | Error Continue -> + let* _ = do_update () in + loop () + | Error Break -> Ok () + | Error e -> Error e + else Ok () + in + loop () diff --git a/lib/lexer.ml b/lib/lexer.ml index 0a4134b..668b2d0 100644 --- a/lib/lexer.ml +++ b/lib/lexer.ml @@ -14,7 +14,7 @@ open Error | String of string | Number of float - | And | Break | Class | Else | False | Fun | For | If | Nil | Or | Print | Return | Super | This | True + | And | Break | Class | Continue | Else | False | Fun | For | If | Nil | Or | Print | Return | Super | This | True | Var | While | Comment of string @@ -29,11 +29,11 @@ let keywords = Hashtbl.add keywords s tt; keywords in - 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 + keywords |> insert "and" And |> insert "break" Break |> insert "class" Class + |> insert "continue" Continue |> 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 07b3d8e..b4fdbc9 100644 --- a/lib/lexer.mli +++ b/lib/lexer.mli @@ -24,6 +24,7 @@ type token_type = | And | Break | Class + | Continue | Else | False | Fun diff --git a/lib/parser.ml b/lib/parser.ml index 53d51c2..df280ac 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -265,16 +265,11 @@ and while_loop (state : state ref) : stmt_result = let* _ = consume state LeftParen in let* cond = expression state in let* _ = consume state RightParen 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 = - let for_pos = cur_pos state in + let pos = cur_pos state in let* _ = consume state For in let* _ = consume state LeftParen in let* init = @@ -287,10 +282,8 @@ and for_loop (state : state ref) : stmt_result = in let* cond = match peek_tt state with - | Semicolon -> - let pos = cur_pos state in - Ok (make_bool pos true) - | _ -> expression state + | Semicolon -> Ok None + | _ -> expression state |> Result.map Option.some in (* expression has no final semicolon, so we need to consume it *) let* _ = consume state Semicolon in @@ -300,24 +293,8 @@ and for_loop (state : state ref) : stmt_result = | _ -> expression state |> Result.map Option.some in let* _ = consume state RightParen 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 -> - let update_stmt = make_expr_stmt update.pos update in - make_block body.pos [ body; update_stmt ] - | None -> body - in - let loop = make_while for_pos cond body in - let outer_block = - match init with Some init -> make_block for_pos [ init; loop ] | None -> loop - in - Ok outer_block + make_for pos init cond update body |> Result.ok and expr_stmt (state : state ref) : stmt_result = let pos = cur_pos state in @@ -337,6 +314,14 @@ and statement (state : state ref) : stmt_result = else let msg = "Can use break only in loops" in ParserError.make pos msg |> Result.error + | Continue -> + if !state.is_in_loop then ( + advance state; + let* _ = consume state Semicolon in + make_continue pos |> Result.ok) + else + let msg = "Can use continue only in loops" in + ParserError.make pos msg |> Result.error | Print -> advance state; let* expr = expression state in diff --git a/lib/stmt.ml b/lib/stmt.ml index 59d398a..d1d600b 100644 --- a/lib/stmt.ml +++ b/lib/stmt.ml @@ -1,15 +1,23 @@ +open Error open Expr type stmt = | Expr of expr_node | Break + | Continue | Print of expr_node | VarDecl of { name : string; init : expr_node option } | Block of stmt_node list | If of { cond : expr_node; then_ : stmt_node; else_ : stmt_node option } | While of { cond : expr_node; body : stmt_node } + | For of { + init : stmt_node option; + cond : expr_node option; + update : expr_node option; + body : stmt_node; + } -and stmt_node = { stmt : stmt; pos : Error.code_pos } +and stmt_node = { stmt : stmt; pos : code_pos } let rec show_stmt ?(indent = 0) stmt = let indent_s = String.make indent ' ' in @@ -18,10 +26,11 @@ let rec show_stmt ?(indent = 0) stmt = match stmt with | Expr expr -> indent_s ^ "Expr\n" ^ show_expr_ind expr.expr | Break -> indent_s ^ "Break" + | Continue -> indent_s ^ "Continue" | Print expr -> indent_s ^ "Print\n" ^ show_expr_ind expr.expr - | VarDecl { name; init } -> ( - indent_s ^ "Var " ^ name - ^ match init with Some init -> " = \n" ^ show_expr_ind init.expr | None -> "") + | VarDecl { name; init } -> + let init_s = match init with Some init -> " = \n" ^ show_expr_ind init.expr | None -> "" in + indent_s ^ "Var " ^ name ^ init_s | Block stmts -> let stmts_s = List.fold_left (fun acc stmt -> acc ^ show_stmt_ind stmt.stmt ^ "\n") "" stmts @@ -37,27 +46,58 @@ let rec show_stmt ?(indent = 0) stmt = let cond_s = show_expr_ind ~add:4 cond.expr in let body_s = show_stmt_ind ~add:4 body.stmt in indent_s ^ "While\n" ^ indent_s ^ " Cond\n" ^ cond_s ^ "\n" ^ indent_s ^ " Body\n" ^ body_s + | For { init; cond; update; body } -> + (* let init_s = + match init with + | Some { stmt = init; _ } -> indent_s ^ " Init\n" ^ show_stmt_ind ~add:4 init + | None -> "" + in *) + let init_s = + init + |> Option.map (fun { stmt = init; _ } -> indent_s ^ " Init\n" ^ show_stmt_ind ~add:4 init) + |> Option.value ~default:"" + in + (* let cond_s = + match cond with + | Some { expr = cond; _ } -> indent_s ^ " Cond\n" ^ show_expr_ind ~add:4 cond + | None -> "" *) + let cond_s = + cond + |> Option.map (fun { expr = cond; _ } -> indent_s ^ " Cond\n" ^ show_expr_ind ~add:4 cond) + |> Option.value ~default:"" + in + (* let update_s = + match update with + | Some { expr = update; _ } -> indent_s ^ " Update\n" ^ show_expr_ind ~add:4 update + | None -> "" *) + let update_s = + update + |> Option.map (fun { expr = update; _ } -> + indent_s ^ " Update\n" ^ show_expr_ind ~add:4 update) + |> Option.value ~default:"" + in + let body_s = indent_s ^ " Body\n" ^ show_stmt_ind ~add:4 body.stmt in + indent_s ^ "For\n" ^ init_s ^ cond_s ^ update_s ^ body_s let show_stmt_node stmt_node = show_stmt stmt_node.stmt -let make_stmt_node (pos : Error.code_pos) (stmt : stmt) : stmt_node = { stmt; pos } +let make_stmt_node (pos : code_pos) (stmt : stmt) : stmt_node = { stmt; pos } +let make_expr_stmt (pos : code_pos) (expr : expr_node) : stmt_node = Expr expr |> make_stmt_node pos +let make_break (pos : code_pos) : stmt_node = Break |> make_stmt_node pos +let make_continue (pos : code_pos) : stmt_node = Continue |> make_stmt_node pos +let make_print (pos : code_pos) (expr : expr_node) : stmt_node = Print expr |> make_stmt_node pos -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 - -let make_var_decl (pos : Error.code_pos) (name : string) (init : expr_node option) = +let make_var_decl (pos : code_pos) (name : string) (init : expr_node option) = VarDecl { name; init } |> make_stmt_node pos -let make_block (pos : Error.code_pos) (stmts : stmt_node list) : stmt_node = +let make_block (pos : code_pos) (stmts : stmt_node list) : stmt_node = Block stmts |> make_stmt_node pos -let make_if (pos : Error.code_pos) (cond : expr_node) (then_ : stmt_node) (else_ : stmt_node option) - = +let make_if (pos : code_pos) (cond : expr_node) (then_ : stmt_node) (else_ : stmt_node option) = If { cond; then_; else_ } |> make_stmt_node pos -let make_while (pos : Error.code_pos) (cond : expr_node) (body : stmt_node) = +let make_while (pos : code_pos) (cond : expr_node) (body : stmt_node) = While { cond; body } |> make_stmt_node pos + +let make_for (pos : code_pos) (init : stmt_node option) (cond : expr_node option) + (update : expr_node option) (body : stmt_node) = + For { init; cond; update; body } |> make_stmt_node pos