moved exprs into nodes with code position

lib/error.ml

@@ -21,7 +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 lox_error = LexerError of lexer_error list | ParserError of parser_error list
+type interpreter_error = { pos : code_pos; msg : string }
+
+module InterpreterError = struct
+  type t = parser_error
+
+  let make (pos : code_pos) (msg : string) : interpreter_error = { pos; msg }
+
+  let print (e : interpreter_error) =
+    Printf.printf "InterpreterError at line %d, column %d: %s\n" e.pos.line e.pos.col e.msg
+end
+
+type lox_error =
+  | LexerError of lexer_error list
+  | ParserError of parser_error list
+  | InterpreterError of interpreter_error
 
 let print_error (e : lox_error) =
   match e with
@@ -37,6 +51,8 @@ let print_error (e : lox_error) =
       Printf.printf "found %d %s:\n" num_errors
         (if num_errors = 1 then "ParserError" else "ParserErrors");
       List.iter ParserError.print es
+  | InterpreterError e -> InterpreterError.print e
 
 let of_lexer_error e = Result.map_error (fun e -> LexerError e) e
 let of_parser_error e = Result.map_error (fun e -> ParserError e) e
+let of_interpreter_error e = Result.map_error (fun e -> InterpreterError e) e

lib/expr.ml

@@ -8,16 +8,28 @@ let show_literal literal =
   | Bool b -> string_of_bool b
   | Nil -> "nil"
 
-type binary_op = Plus | Minus | Mul | Div | Equal | Less | Greater | LessEqual | GreaterEqual
+type binary_op =
+  | Plus
+  | Minus
+  | Mul
+  | Div
+  | Equal
+  | Less
+  | Greater
+  | LessEqual
+  | GreaterEqual
+  | And
+  | Or
 [@@deriving show { with_path = false }]
 
 type unary_op = Neg | Not [@@deriving show { with_path = false }]
 
 type expr =
   | Literal of literal
-  | BinaryExpr of { op : binary_op; left : expr; right : expr }
+  | BinaryExpr of { op : binary_op; left : expr_node; right : expr_node }
-  | UnaryExpr of { op : unary_op; expr : expr }
+  | UnaryExpr of { op : unary_op; expr : expr_node }
-(* [@@deriving show { with_path = false }] *)
+
+and expr_node = { expr : expr; pos : Error.code_pos }
 
 let rec show_expr ?(indent = 0) expr =
   let show_indented = show_expr ~indent:(indent + 2) in
@@ -25,12 +37,17 @@ let rec show_expr ?(indent = 0) expr =
   match expr with
   | Literal literal -> ident_s ^ show_literal literal
   | BinaryExpr { op; left; right } ->
-      ident_s ^ show_binary_op op ^ "\n" ^ show_indented left ^ "\n" ^ show_indented right
+      ident_s ^ show_binary_op op ^ "\n" ^ show_indented left.expr ^ "\n" ^ show_indented right.expr
-  | UnaryExpr { op; expr } -> ident_s ^ show_unary_op op ^ "\n" ^ show_indented expr
+  | UnaryExpr { op; expr } -> ident_s ^ show_unary_op op ^ "\n" ^ show_indented expr.expr
 
-let make_string (s : string) = Literal (String s)
+let make_expr_node (pos : Error.code_pos) (expr : expr) = { expr; pos }
-let make_number (x : float) = Literal (Number x)
+let make_string (pos : Error.code_pos) (s : string) = make_expr_node pos (Literal (String s))
-let make_bool (b : bool) = Literal (Bool b)
+let make_number (pos : Error.code_pos) (x : float) = make_expr_node pos (Literal (Number x))
-let make_nil () = Literal Nil
+let make_bool (pos : Error.code_pos) (b : bool) = make_expr_node pos (Literal (Bool b))
-let make_binary (op : binary_op) (left : expr) (right : expr) = BinaryExpr { op; left; right }
+let make_nil (pos : Error.code_pos) = make_expr_node pos (Literal Nil)
-let make_unary (op : unary_op) (expr : expr) = UnaryExpr { op; expr }
+
+let make_binary (pos : Error.code_pos) (op : binary_op) (left : expr_node) (right : expr_node) =
+  make_expr_node pos (BinaryExpr { op; left; right })
+
+let make_unary (pos : Error.code_pos) (op : unary_op) (expr : expr_node) =
+  make_expr_node pos (UnaryExpr { op; expr })

lib/interpreter.ml

@@ -0,0 +1,47 @@
+let ( let* ) = Result.bind
+
+open Expr
+open Error
+open Value
+
+let value_of_literal (literal : literal) : Value.lox_value =
+  match literal with String s -> String s | Number x -> Number x | Bool b -> Bool b | Nil -> Nil
+
+let rec interpret_expr (expr : expr_node) : (lox_value, interpreter_error) result =
+  let pos = expr.pos in
+  match expr.expr with
+  | Literal literal -> Ok (value_of_literal literal)
+  | BinaryExpr { op; left; right } -> (
+      let* left = interpret_expr left in
+      let* right = interpret_expr 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))
+      | Number x, Div, Number y -> Ok (Number (x /. y))
+      | Number x, Equal, Number y -> Ok (Bool (x = y))
+      | 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))
+      | Bool b, And, Bool c -> Ok (Bool (b && c))
+      | Bool b, Or, Bool c -> Ok (Bool (b || c))
+      | _, Equal, _ -> Ok (Bool (left = right))
+      | _, _, _ ->
+          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 (InterpreterError.make pos msg))
+  | UnaryExpr { op; expr } -> (
+      let* expr = interpret_expr expr in
+      match (op, expr) with
+      | Neg, Number x -> Ok (Number (-.x))
+      | Not, Bool b -> Ok (Bool (not b))
+      | _, _ ->
+          let msg =
+            Printf.sprintf "Invalid operant of type %s to operator %s"
+              (type_string_of_lox_value expr) (show_unary_op op)
+          in
+          Error (InterpreterError.make pos msg))

lib/lox.ml

@@ -2,21 +2,22 @@ let ( let* ) = Result.bind
 
 module Error = Error
 module Expr = Expr
+module Interpreter = Interpreter
 module Lexer = Lexer
 module Parser = Parser
 
-type token = Lexer.token
 type lox_error = Error.lox_error
-type lox_value = Nil
 
 let run (source : string) : (unit, lox_error) result =
   let* tokens = Error.of_lexer_error (Lexer.tokenize source) in
-  let f token = Printf.printf "%s " (Lexer.show_token token) in
+  (* let f token = Printf.printf "%s " (Lexer.show_token token) in
       Printf.printf "Got %d tokens\n" (List.length tokens);
       List.iter f tokens;
-  print_endline "";
+     print_newline (); *)
-  let* expr = Error.of_parser_error (Parser.parse tokens) in
+  let* ast = Error.of_parser_error (Parser.parse tokens) in
-  Printf.printf "%s\n" (Expr.show_expr expr);
+  (* Printf.printf "%s\n" (Expr.show_expr expr); *)
+  let* value = Error.of_interpreter_error (Interpreter.interpret_expr ast) in
+  print_endline (Value.string_of_lox_value value);
   Ok ()
 
 let runRepl () : unit =

lib/parser.ml

@@ -4,14 +4,14 @@ open Error
 open Expr
 open Lexer
 
-type parse_result = (expr, parser_error list) result
+type parse_result = (expr_node, parser_error list) result
-type expr_result = (expr, parser_error) result
+type expr_result = (expr_node, parser_error) result
 type state = { tokens : token list; errors_rev : parser_error list }
 
 let is_at_end state = (List.hd !state.tokens).token_type == Eof
 
 let append_error msg pos state =
-  let e = { pos; msg } in
+  let e = ParserError.make pos msg in
   { state with errors_rev = e :: state.errors_rev }
 
 let advance state = state := { !state with tokens = List.tl !state.tokens }
@@ -36,16 +36,8 @@ let matches state tts =
 let cur_pos state = (peek state).pos
 
 let collect_chain (state : state ref) (tts : token_type array)
-    (higher_prec : state ref -> expr_result) : ((expr * token) array, parser_error) result =
+    (higher_prec : state ref -> expr_result) : ((expr_node * token) array, parser_error) result =
-  (* ([], state) *)
+  let rec collect_chain_rec (acc : (expr_node * token) list) =
-  (* let out_list_rev = ref [] in
-     while (not (is_at_end state)) && matches state tts do
-       let token = next state in
-       let expr = higher_prec state in
-       out_list_rev := (expr, token) :: !out_list_rev
-     done;
-     Ok (Array.of_list (List.rev !out_list_rev)) *)
-  let rec collect_chain_rec (acc : (expr * token) list) =
     if (not (is_at_end state)) && matches state tts then
       let token = next state in
       let* expr = higher_prec state in
@@ -53,16 +45,26 @@ let collect_chain (state : state ref) (tts : token_type array)
       collect_chain_rec acc
     else Ok acc
   in
-  (* match collect_chain_rec [] with Ok l -> Ok (Array.of_list (List.rev l)) | Error e -> Error e *)
   collect_chain_rec [] |> Result.map (fun l -> Array.of_list (List.rev l))
 
 let primary (state : state ref) : expr_result =
+  let pos = cur_pos state in
   match (peek state).token_type with
-  | Number x -> Ok (make_number x)
+  | Number x ->
-  | String s -> Ok (make_string s)
+      advance state;
-  | True -> Ok (make_bool true)
+      Ok (make_number pos x)
-  | False -> Ok (make_bool false)
+  | String s ->
-  | Nil -> Ok (make_nil ())
+      advance state;
+      Ok (make_string pos s)
+  | True ->
+      advance state;
+      Ok (make_bool pos true)
+  | False ->
+      advance state;
+      Ok (make_bool pos false)
+  | Nil ->
+      advance state;
+      Ok (make_nil pos)
   | tt ->
       let msg = Printf.sprintf "Unexpected %s, expected valid expression" (show_token_type tt) in
       let pos = (peek state).pos in
@@ -72,7 +74,7 @@ let rec grouping (state : state ref) : expr_result =
   if matches state [| LeftParen |] then (
     advance state;
     let* expr = expression state in
-    if advance_if state RightParen then Ok expr
+    if advance_if state RightParen then Ok expr (* expect a ) here *)
     else
       let pos = cur_pos state in
       let tt = (peek state).token_type in
@@ -83,6 +85,7 @@ let rec grouping (state : state ref) : expr_result =
 and neg_not (state : state ref) : expr_result =
   if matches state [| Bang; Minus |] then
     let token = next state in
+    let pos = token.pos in
     let* expr = neg_not state in
     let op =
       match token.token_type with
@@ -90,7 +93,7 @@ and neg_not (state : state ref) : expr_result =
       | Minus -> Neg
       | _ -> assert false (* should only be here if tt is - ! *)
     in
-    let expr = make_unary op expr in
+    let expr = make_unary pos op expr in
     Ok expr
   else grouping state
 
@@ -98,13 +101,14 @@ and mul_or_div (state : state ref) : expr_result =
   let* expr = neg_not state in
   let* exprs_tokens = collect_chain state [| Star; Slash |] neg_not in
   let f acc (expr, token) =
+    let pos = token.pos in
     let op : binary_op =
       match token.token_type with
       | Star -> Mul
       | Slash -> Div
       | _ -> assert false (* should only be here if tt is * / *)
     in
-    make_binary op acc expr
+    make_binary pos op acc expr
   in
   let expr = Array.fold_left f expr exprs_tokens in
   Ok expr
@@ -113,13 +117,14 @@ and sum_or_diff (state : state ref) : expr_result =
   let* expr = mul_or_div state in
   let* exprs_tokens = collect_chain state [| Plus; Minus |] mul_or_div in
   let f acc (expr, token) =
+    let pos = token.pos in
     let op : binary_op =
       match token.token_type with
       | Plus -> Plus
       | Minus -> Minus
       | _ -> assert false (* should only be here if tt is + - *)
     in
-    make_binary op acc expr
+    make_binary pos op acc expr
   in
   let expr = Array.fold_left f expr exprs_tokens in
   Ok expr
@@ -131,6 +136,7 @@ and inequality (state : state ref) : expr_result =
     collect_chain state [| Greater; GreaterEqual; Less; LessEqual |] sum_or_diff
   in
   let f acc (expr, token) =
+    let pos = token.pos in
     let (op : binary_op) =
       match token.token_type with
       | Greater -> Greater
@@ -139,7 +145,7 @@ and inequality (state : state ref) : expr_result =
       | LessEqual -> LessEqual
       | _ -> assert false (* should only be here if tt is > < >= <= *)
     in
-    make_binary op acc expr
+    make_binary pos op acc expr
   in
   let expr = Array.fold_left f expr exprs_tokens in
   Ok expr
@@ -148,11 +154,12 @@ and equality (state : state ref) : expr_result =
   let* expr = inequality state in
   let* exprs_tokens = collect_chain state [| EqualEqual; BangEqual |] inequality in
   let f acc (expr, token) =
+    let pos = token.pos in
     match token.token_type with
-    | EqualEqual -> make_binary Equal acc expr
+    | EqualEqual -> make_binary pos Equal acc expr
     | BangEqual ->
-        let expr = make_binary Equal acc expr in
+        let expr = make_binary pos Equal acc expr in
-        make_unary Not expr
+        make_unary pos Not expr
     | _ -> assert false (* should only be here if tt is == != *)
   in
   let expr = Array.fold_left f expr exprs_tokens in
@@ -170,7 +177,9 @@ let rec synchronise (state : state ref) =
 
 let parse (tokens : token list) : parse_result =
   let state = ref { tokens; errors_rev = [] } in
-  expression state |> Result.map_error (fun e -> [ e ])
+  let result = expression state |> Result.map_error (fun e -> [ e ]) in
+  assert (Result.is_error result || (peek state).token_type = Eof);
+  result
 (* let expr = State.expression state in
    let state =
      if not (State.is_at_end state) then

lib/value.ml

@@ -0,0 +1,16 @@
+type lox_value = String of string | Number of float | Bool of bool | Nil
+[@@deriving show { with_path = false }]
+
+let string_of_lox_value lox_value =
+  match lox_value with
+  | String s -> s
+  | Number x -> string_of_float x
+  | Bool b -> string_of_bool b
+  | Nil -> "nil"
+
+let type_string_of_lox_value lox_value =
+  match lox_value with
+  | String _ -> "String"
+  | Number _ -> "Number"
+  | Bool _ -> "Bool"
+  | Nil -> "Nil"