From a8290a410458eed36a30e0b4f670a7a4cd485547 Mon Sep 17 00:00:00 2001 From: Moritz Gmeiner Date: Sat, 17 Aug 2024 13:32:59 +0200 Subject: [PATCH] moved exprs into nodes with code position --- lib/error.ml | 18 ++++++++++++- lib/expr.ml | 41 ++++++++++++++++++++--------- lib/interpreter.ml | 47 +++++++++++++++++++++++++++++++++ lib/lox.ml | 17 ++++++------ lib/parser.ml | 65 ++++++++++++++++++++++++++-------------------- lib/value.ml | 16 ++++++++++++ 6 files changed, 155 insertions(+), 49 deletions(-) create mode 100644 lib/interpreter.ml create mode 100644 lib/value.ml diff --git a/lib/error.ml b/lib/error.ml index 8e7a4f0..e5e2cf6 100644 --- a/lib/error.ml +++ b/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 diff --git a/lib/expr.ml b/lib/expr.ml index f2b135c..6b4874d 100644 --- a/lib/expr.ml +++ b/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 } - | UnaryExpr of { op : unary_op; expr : expr } -(* [@@deriving show { with_path = false }] *) + | BinaryExpr of { op : binary_op; left : expr_node; right : expr_node } + | UnaryExpr of { op : unary_op; expr : expr_node } + +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 - | UnaryExpr { op; expr } -> ident_s ^ show_unary_op op ^ "\n" ^ show_indented expr + 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.expr -let make_string (s : string) = Literal (String s) -let make_number (x : float) = Literal (Number x) -let make_bool (b : bool) = Literal (Bool b) -let make_nil () = Literal Nil -let make_binary (op : binary_op) (left : expr) (right : expr) = BinaryExpr { op; left; right } -let make_unary (op : unary_op) (expr : expr) = UnaryExpr { op; expr } +let make_expr_node (pos : Error.code_pos) (expr : expr) = { expr; pos } +let make_string (pos : Error.code_pos) (s : string) = make_expr_node pos (Literal (String s)) +let make_number (pos : Error.code_pos) (x : float) = make_expr_node pos (Literal (Number x)) +let make_bool (pos : Error.code_pos) (b : bool) = make_expr_node pos (Literal (Bool b)) +let make_nil (pos : Error.code_pos) = make_expr_node pos (Literal Nil) + +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 }) diff --git a/lib/interpreter.ml b/lib/interpreter.ml new file mode 100644 index 0000000..1984f93 --- /dev/null +++ b/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)) diff --git a/lib/lox.ml b/lib/lox.ml index 58d60fb..c973fea 100644 --- a/lib/lox.ml +++ b/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 - Printf.printf "Got %d tokens\n" (List.length tokens); - List.iter f tokens; - print_endline ""; - let* expr = Error.of_parser_error (Parser.parse tokens) in - Printf.printf "%s\n" (Expr.show_expr expr); + (* 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_newline (); *) + let* ast = Error.of_parser_error (Parser.parse tokens) in + (* 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 = diff --git a/lib/parser.ml b/lib/parser.ml index bd40a70..76aaff1 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -4,14 +4,14 @@ open Error open Expr open Lexer -type parse_result = (expr, parser_error list) result -type expr_result = (expr, parser_error) result +type parse_result = (expr_node, parser_error list) 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 = - (* ([], state) *) - (* 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) = + (higher_prec : state ref -> expr_result) : ((expr_node * token) array, parser_error) result = + let rec collect_chain_rec (acc : (expr_node * 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) - | String s -> Ok (make_string s) - | True -> Ok (make_bool true) - | False -> Ok (make_bool false) - | Nil -> Ok (make_nil ()) + | Number x -> + advance state; + Ok (make_number pos x) + | String s -> + 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 - make_unary Not expr + let expr = make_binary pos Equal acc expr in + 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 diff --git a/lib/value.ml b/lib/value.ml new file mode 100644 index 0000000..6679317 --- /dev/null +++ b/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"