From be931b7214657ec3a9ffb9d1f39d9b941374c3eb Mon Sep 17 00:00:00 2001 From: Moritz Gmeiner Date: Tue, 27 Aug 2024 20:32:05 +0200 Subject: [PATCH] implemented calls --- lib/error.ml | 4 +-- lib/expr.ml | 45 ++++++++++++++++++-------------- lib/interpreter.ml | 30 ++++++++++++++++++--- lib/lox.ml | 6 ++--- lib/parser.ml | 65 ++++++++++++++++++++++++++++++---------------- lox.t/run.t | 20 ++++++++++---- 6 files changed, 115 insertions(+), 55 deletions(-) diff --git a/lib/error.ml b/lib/error.ml index ce67da5..adb6703 100644 --- a/lib/error.ml +++ b/lib/error.ml @@ -48,13 +48,13 @@ let print_error (e : lox_error) = | LexerError es -> let num_errors = List.length es in assert (num_errors <> 0); - Printf.fprintf stderr "found %d %s:\n" num_errors + Printf.eprintf "found %d %s:\n%!" num_errors (if num_errors = 1 then "LexerError" else "LexerErrors"); List.iter (fun e -> LexerError.show e |> prerr_endline) es | ParserError es -> let num_errors = List.length es in assert (num_errors <> 0); - Printf.fprintf stderr "found %d %s:\n" num_errors + Printf.eprintf "found %d %s:\n%!" num_errors (if num_errors = 1 then "ParserError" else "ParserErrors"); List.iter (fun e -> ParserError.show e |> prerr_endline) es | RuntimeError e -> RuntimeError.show e |> prerr_endline diff --git a/lib/expr.ml b/lib/expr.ml index 52c355f..c8a1277 100644 --- a/lib/expr.ml +++ b/lib/expr.ml @@ -1,3 +1,5 @@ +open Error + type literal = String of string | Number of float | Bool of bool | Nil [@@deriving show { with_path = false }] @@ -32,11 +34,12 @@ type expr = | Unary of { op : unary_op; expr : expr_node } | Binary of { op : binary_op; left : expr_node; right : expr_node } | Logical of { op : logical_op; left : expr_node; right : expr_node } + | Call of { callee : expr_node; args : expr_node list } -and expr_node = { expr : expr; pos : Error.code_pos } +and expr_node = { expr : expr; pos : code_pos } let rec show_expr ?(indent = 0) expr = - let show_indented = show_expr ~indent:(indent + 2) in + let show_indented ?(add = 2) = show_expr ~indent:(indent + add) in let indent_s = String.make indent ' ' in match expr with | Literal literal -> indent_s ^ show_literal literal @@ -49,30 +52,34 @@ let rec show_expr ?(indent = 0) expr = | Logical { op; left; right } -> indent_s ^ show_logical_op op ^ "\n" ^ show_indented left.expr ^ "\n" ^ show_indented right.expr + | Call { callee; args } -> + let callee_s = show_indented ~add:4 callee.expr in + let args_s = + List.map (fun arg -> show_indented ~add:4 arg.expr) args + |> List.fold_left (fun acc s -> acc ^ s) "" + in + indent_s ^ "Call\n" ^ indent_s ^ " Callee\n" ^ callee_s ^ "\n" ^ indent_s ^ " Args\n" + ^ args_s let show_expr_node expr_node = show_expr expr_node.expr -let make_expr_node (pos : Error.code_pos) (expr : expr) : expr_node = { expr; pos } +let make_expr_node (pos : code_pos) (expr : expr) : expr_node = { expr; pos } +let make_string (pos : code_pos) (s : string) : expr_node = Literal (String s) |> make_expr_node pos +let make_number (pos : code_pos) (x : float) : expr_node = Literal (Number x) |> make_expr_node pos +let make_bool (pos : code_pos) (b : bool) : expr_node = Literal (Bool b) |> make_expr_node pos +let make_nil (pos : code_pos) = Literal Nil |> make_expr_node pos +let make_variable (pos : code_pos) (name : string) : expr_node = Variable name |> make_expr_node pos -let make_string (pos : Error.code_pos) (s : string) : expr_node = - Literal (String s) |> make_expr_node pos - -let make_number (pos : Error.code_pos) (x : float) : expr_node = - Literal (Number x) |> make_expr_node pos - -let make_bool (pos : Error.code_pos) (b : bool) : expr_node = Literal (Bool b) |> make_expr_node pos -let make_nil (pos : Error.code_pos) = Literal Nil |> make_expr_node pos - -let make_variable (pos : Error.code_pos) (name : string) : expr_node = - Variable name |> make_expr_node pos - -let make_assignment (pos : Error.code_pos) (name : string) (expr : expr_node) : expr_node = +let make_assignment (pos : code_pos) (name : string) (expr : expr_node) : expr_node = Assignment { name; expr } |> make_expr_node pos -let make_unary (pos : Error.code_pos) (op : unary_op) (expr : expr_node) = +let make_unary (pos : code_pos) (op : unary_op) (expr : expr_node) = Unary { op; expr } |> make_expr_node pos -let make_binary (pos : Error.code_pos) (op : binary_op) (left : expr_node) (right : expr_node) = +let make_binary (pos : code_pos) (op : binary_op) (left : expr_node) (right : expr_node) = Binary { op; left; right } |> make_expr_node pos -let make_logical (pos : Error.code_pos) (op : logical_op) (left : expr_node) (right : expr_node) = +let make_logical (pos : code_pos) (op : logical_op) (left : expr_node) (right : expr_node) = Logical { op; left; right } |> make_expr_node pos + +let make_call (pos : code_pos) (callee : expr_node) (args : expr_node list) = + Call { callee; args } |> make_expr_node pos diff --git a/lib/interpreter.ml b/lib/interpreter.ml index a4014a1..c66fb62 100644 --- a/lib/interpreter.ml +++ b/lib/interpreter.ml @@ -75,13 +75,34 @@ let rec interpret_expr (env : environment) (expr_node : expr_node) : match (op, lox_value_to_bool left) with | And, false | Or, true -> Ok left (* short circuit *) | _ -> interpret_expr env right) + | Call { callee; args } -> ( + let* callee = interpret_expr env callee in + let f (acc : (lox_value list, runtime_error) result) (arg : expr_node) : + (lox_value list, runtime_error) result = + match acc with + | Ok acc -> + let* arg = interpret_expr env arg in + Ok (arg :: acc) + | Error e -> Error e + in + let* args = List.fold_left f (Ok []) args in + let args = List.rev args in + let args_s = + List.fold_left (fun acc value -> acc ^ " " ^ string_of_lox_value value) "" args + in + Printf.eprintf "Called %s with args%s\n%!" (string_of_lox_value callee) args_s; + match callee with + | _ -> + let msg = Printf.sprintf "%s object is not callable" (type_string_of_lox_value callee) in + RuntimeError.make pos msg |> Result.error) let rec interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runtime_error) result = let { pos; stmt } = stmt_node in ignore pos; match stmt with | Expr expr -> - let* _ = interpret_expr env expr in + let* value = interpret_expr env expr in + ignore value; Ok () | Break -> RuntimeError.break () |> Result.error | Continue -> RuntimeError.continue () |> Result.error @@ -101,7 +122,7 @@ let rec interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runt let rec _interpret stmts = match stmts with | stmt :: tail -> - let* _ = interpret_stmt env stmt in + let* () = interpret_stmt env stmt in _interpret tail | [] -> Ok () in @@ -123,7 +144,7 @@ let rec interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runt else Ok () | For { init; cond; update; body } -> let env = Env.enter env in - let* _ = init |> Option.map (interpret_stmt env) |> Option.value ~default:(Ok ()) in + let* () = init |> Option.map (interpret_stmt env) |> Option.value ~default:(Ok ()) in let eval_cond () = cond |> Option.map (interpret_expr env) @@ -139,7 +160,8 @@ let rec interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runt let result = interpret_stmt env body in match result with | Ok () | Error Continue -> - let* _ = do_update () in + let* value = do_update () in + ignore value; loop () | Error Break -> Ok () | Error e -> Error e diff --git a/lib/lox.ml b/lib/lox.ml index e462358..14e776a 100644 --- a/lib/lox.ml +++ b/lib/lox.ml @@ -17,8 +17,8 @@ let run ?(env : Environment.environment option) ?(debug = false) (source : strin if debug then let print_tokens () = prerr_endline "--- Tokens ---"; - let f token = Printf.fprintf stderr "%s " (Lexer.show_token token) in - Printf.fprintf stderr "Got %d tokens\n" (List.length tokens); + let f token = Printf.eprintf "%s %!" (Lexer.show_token token) in + Printf.eprintf "Got %d tokens\n%!" (List.length tokens); List.iter f tokens; prerr_newline (); prerr_endline "--------------"; @@ -44,7 +44,7 @@ let run ?(env : Environment.environment option) ?(debug = false) (source : strin match stmts with | [] -> Ok () | stmt :: tail -> - let* _ = Interpreter.interpret_stmt env stmt in + let* () = Interpreter.interpret_stmt env stmt in interpret_stmts tail in interpret_stmts stmts |> Error.of_runtimer_error diff --git a/lib/parser.ml b/lib/parser.ml index 76c8d5d..3dc4bd4 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -10,14 +10,14 @@ type state = { tokens : token list ref; is_in_loop : bool } type stmt_result = (stmt_node, parser_error) result type expr_result = (expr_node, parser_error) result +let make_state tokens = { tokens; is_in_loop = false } + let with_is_in_loop (f : state -> 'a) (state : state) : 'a = let new_state = { state with is_in_loop = true } in let result = f new_state in (* state.tokens <- new_state.tokens; *) result -let make_state tokens = { tokens; is_in_loop = false } - let is_at_end state = assert (not (List.is_empty !(state.tokens))); (List.hd !(state.tokens)).token_type = Eof @@ -40,7 +40,7 @@ let advance_if state tt = else false let consume state tt = - if advance_if state tt then Ok state + if advance_if state tt then Ok () else let pos = cur_pos state in let tt' = peek_tt state in @@ -111,6 +111,27 @@ let rec grouping (state : state) : expr_result = Error { pos; msg }) else primary state +and call (state : state) : expr_result = + let* expr = grouping state in + let pos = cur_pos state in + if advance_if state LeftParen then + let* args = + if peek_tt state = RightParen then Ok [] + else + let* first_arg = expression state in + let* exprs_tokens = collect_chain state [| Comma |] expression in + let other_args = List.map fst exprs_tokens in + let args = first_arg :: other_args in + Ok args + in + if List.length args >= 255 then + let msg = "Can't call with more than 255 arguments" in + ParserError.make pos msg |> Result.error + else + let* () = consume state RightParen in + make_call pos expr args |> Result.ok + else Ok expr + and neg_not (state : state) : expr_result = if matches state [| Bang; Minus |] then let token = next state in @@ -124,7 +145,7 @@ and neg_not (state : state) : expr_result = in let expr = make_unary pos op expr in Ok expr - else grouping state + else call state and mul_or_div (state : state) : expr_result = let* expr = neg_not state in @@ -232,7 +253,7 @@ and expression (state : state) : expr_result = assignment state let rec block (state : state) : stmt_result = let pos = cur_pos state in - let* _ = consume state LeftBrace in + let* () = consume state LeftBrace in let rec collect_stmts state = if is_at_end state then let msg = "Unterminated block" in @@ -246,15 +267,15 @@ let rec block (state : state) : stmt_result = Ok (stmt :: tail) in let* stmts = collect_stmts state in - let* _ = consume state RightBrace in + let* () = consume state RightBrace in make_block pos stmts |> Result.ok and if_then_else (state : state) : stmt_result = let pos = cur_pos state in - let* _ = consume state If in - let* _ = consume state LeftParen in + let* () = consume state If in + let* () = consume state LeftParen in let* cond = expression state in - let* _ = consume state RightParen in + let* () = consume state RightParen in let* then_ = statement state in let* (else_ : stmt_node option) = if advance_if state Else then statement state |> Result.map Option.some else Ok None @@ -263,17 +284,17 @@ and if_then_else (state : state) : stmt_result = and while_loop (state : state) : stmt_result = let pos = cur_pos state in - let* _ = consume state While in - let* _ = consume state LeftParen in + let* () = consume state While in + let* () = consume state LeftParen in let* cond = expression state in - let* _ = consume state RightParen in + let* () = consume state RightParen in let* body = with_is_in_loop statement state in make_while pos cond body |> Result.ok and for_loop (state : state) : stmt_result = let pos = cur_pos state in - let* _ = consume state For in - let* _ = consume state LeftParen in + let* () = consume state For in + let* () = consume state LeftParen in let* init = match peek_tt state with | Semicolon -> @@ -288,20 +309,20 @@ and for_loop (state : state) : stmt_result = | _ -> expression state |> Result.map Option.some in (* expression has no final semicolon, so we need to consume it *) - let* _ = consume state Semicolon in + let* () = consume state Semicolon in let* update = match peek_tt state with | RightParen -> Ok None | _ -> expression state |> Result.map Option.some in - let* _ = consume state RightParen in + let* () = consume state RightParen in let* body = with_is_in_loop statement state in make_for pos init cond update body |> Result.ok and expr_stmt (state : state) : stmt_result = let pos = cur_pos state in let* expr = expression state in - let* _ = consume state Semicolon in + let* () = consume state Semicolon in let stmt = make_expr_stmt pos expr in Ok stmt @@ -311,7 +332,7 @@ and statement (state : state) : stmt_result = | Break -> if state.is_in_loop then ( advance state; - let* _ = consume state Semicolon in + let* () = consume state Semicolon in make_break pos |> Result.ok) else let msg = "Can use break only in loops" in @@ -319,7 +340,7 @@ and statement (state : state) : stmt_result = | Continue -> if state.is_in_loop then ( advance state; - let* _ = consume state Semicolon in + let* () = consume state Semicolon in make_continue pos |> Result.ok) else let msg = "Can use continue only in loops" in @@ -327,7 +348,7 @@ and statement (state : state) : stmt_result = | Print -> advance state; let* expr = expression state in - let* _ = consume state Semicolon in + let* () = consume state Semicolon in let stmt = make_print pos expr in Ok stmt | LeftBrace -> block state @@ -344,13 +365,13 @@ and var_declaration (state : state) : stmt_result = let* init = if Equal = peek_tt state then (* found =, parsing initialiser *) - let* _ = consume state Equal in + let* () = consume state Equal in let* init = expression state in Ok (Some init) else (* no initialiser, default to nil *) Ok None in - let* _ = consume state Semicolon in + let* () = consume state Semicolon in make_var_decl pos name init |> Result.ok and declaration (state : state) : stmt_result = diff --git a/lox.t/run.t b/lox.t/run.t index 7fecfaf..9d632d3 100644 --- a/lox.t/run.t +++ b/lox.t/run.t @@ -162,23 +162,33 @@ file break/while.lox file call/bool.lox -$ mlox call/bool.lox + $ mlox call/bool.lox + RuntimeError at line 1, column 4: Bool object is not callable + [1] file call/nil.lox -$ mlox call/nil.lox + $ mlox call/nil.lox + RuntimeError at line 1, column 3: Nil object is not callable + [1] file call/num.lox -$ mlox call/num.lox + $ mlox call/num.lox + RuntimeError at line 1, column 3: Number object is not callable + [1] file call/object.lox -$ mlox call/object.lox + $ mlox call/object.lox + ParserError at line 1, column 0: Expected valid expression, got Class instead + [1] file call/string.lox -$ mlox call/string.lox + $ mlox call/string.lox + RuntimeError at line 1, column 5: String object is not callable + [1] file class/empty.lox