implemented calls

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

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 =
+let make_assignment (pos : code_pos) (name : string) (expr : expr_node) : 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 =
   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

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

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
+        let f token = Printf.eprintf "%s %!" (Lexer.show_token token) in
-        Printf.fprintf stderr "Got %d tokens\n" (List.length tokens);
+        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

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 If in
-  let* _ = consume state LeftParen 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 While in
-  let* _ = consume state LeftParen 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 For in
-  let* _ = consume state LeftParen 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 =

lox.t/run.t

@@ -163,22 +163,32 @@ file break/while.lox
 
 file 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
+  RuntimeError at line 1, column 3: Nil object is not callable
+  [1]
 
 
 file 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
+  ParserError at line 1, column 0: Expected valid expression, got Class instead
+  [1]
 
 
 file call/string.lox
   $ mlox call/string.lox
+  RuntimeError at line 1, column 5: String object is not callable
+  [1]
 
 
 file class/empty.lox