From 77e57cd8c297601f090fb3a61f8e4e5d3dc17c2b Mon Sep 17 00:00:00 2001 From: Moritz Gmeiner Date: Mon, 26 Aug 2024 01:58:03 +0200 Subject: [PATCH] global and local variables with scope also reworked arg parsing, now has --debug flag --- bin/main.ml | 30 +++++++---- lib/environment.ml | 67 ++++++++++++++++++++++++ lib/expr.ml | 46 ++++++++++------ lib/interpreter.ml | 53 +++++++++++++++---- lib/lexer.ml | 24 +++++---- lib/lox.ml | 48 ++++++++++++----- lib/parser.ml | 127 ++++++++++++++++++++++++++++++++++----------- lib/stmt.ml | 41 +++++++++++++-- 8 files changed, 341 insertions(+), 95 deletions(-) create mode 100644 lib/environment.ml diff --git a/bin/main.ml b/bin/main.ml index 7c2f3b2..27cd8c1 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,19 +1,27 @@ -let printUsage () = - print_endline "Usage: jlox [script]"; - exit 64 +type args = { debug : bool; file_name : string option } + +let parse_args () : args = + let usage_msg = "mlox [--debug] []" in + let debug = ref false in + let anon = ref [] in + let anon_fun s = anon := s :: !anon in + let spec = [ ("--debug", Arg.Set debug, "Debug mode") ] in + let () = Arg.parse spec anon_fun usage_msg in + let debug = !debug in + let file_and_args = List.rev !anon in + let file_name = List.nth_opt file_and_args 0 in + { debug; file_name } let () = - let argc = Array.length Sys.argv in - match argc - 1 with - | 0 -> Lox.runRepl () - | 1 -> ( - let path = Sys.argv.(1) in + let { debug; file_name } = parse_args () in + match file_name with + | None -> Lox.runRepl ~debug () + | Some file_name -> ( (* Printf.printf "Running script %s\n" path; *) - let ic = open_in path in + let ic = open_in file_name in let source = In_channel.input_all ic in - match Lox.run source with + match Lox.run ~debug source with | Error e -> Lox.Error.print_error e; exit 1 | Ok () -> exit 0) - | _ -> printUsage () diff --git a/lib/environment.ml b/lib/environment.ml new file mode 100644 index 0000000..2d64561 --- /dev/null +++ b/lib/environment.ml @@ -0,0 +1,67 @@ +open Value + +type env_table = (string, lox_value) Hashtbl.t +type environment = { globals : env_table; locals : env_table list } + +module Hashtbl = struct + include Stdlib.Hashtbl + + let contains tbl key = find_opt tbl key |> Option.is_some +end + +module Env = struct + type t = environment + + let make () : t = { globals = Hashtbl.create 0; locals = [] } + + let enter (env : t) : t = + let tbl = Hashtbl.create 0 in + { env with locals = tbl :: env.locals } + + let exit (env : t) : t = + assert (not (List.is_empty env.locals)); + { env with locals = List.tl env.locals } + + let define_global (env : t) (name : string) (value : lox_value) = + Hashtbl.replace env.globals name value + + let get_global (env : t) (name : string) : lox_value option = Hashtbl.find_opt env.globals name + + (* Check if `name` is defined in either locals or globals *) + let is_defined (env : t) (name : string) : bool = + let _is_defined tbl = Hashtbl.contains tbl name in + List.fold_left (fun acc tbl -> acc || _is_defined tbl) false (env.globals :: env.locals) + + let define (env : t) (name : string) (value : lox_value) : bool = + if List.is_empty env.locals then ( + define_global env name value; + true) + else + let tbl = List.hd env.locals in + if Hashtbl.contains tbl name then false + else ( + Hashtbl.add tbl name value; + true) + + let update (env : t) (name : string) (value : lox_value) = + let rec _update tbls = + match tbls with + | [] -> false + | tbl :: tail -> + if Hashtbl.contains tbl name then ( + Hashtbl.replace tbl name value; + true) + else _update tail + in + if _update env.locals then () else Hashtbl.replace env.globals name value + + let get (env : t) (name : string) : lox_value option = + let rec _get tbls = + match tbls with + | [] -> None + | tbl :: tail -> ( + match Hashtbl.find_opt tbl name with Some x -> Some x | None -> _get tail) + in + let val_opt = _get env.locals in + match val_opt with Some x -> Some x | None -> Hashtbl.find_opt env.globals name +end diff --git a/lib/expr.ml b/lib/expr.ml index 7a3dc46..3cfad5b 100644 --- a/lib/expr.ml +++ b/lib/expr.ml @@ -1,12 +1,12 @@ type literal = String of string | Number of float | Bool of bool | Nil [@@deriving show { with_path = false }] -(* let show_literal literal = - match literal with - | String s -> s - | Number x -> string_of_float x - | Bool b -> string_of_bool b - | Nil -> "nil" *) +let show_literal literal = + match literal with + | String s -> "\"" ^ s ^ "\"" + | Number x -> string_of_float x + | Bool b -> string_of_bool b + | Nil -> "nil" type binary_op = | Plus @@ -26,6 +26,8 @@ type unary_op = Neg | Not [@@deriving show { with_path = false }] type expr = | Literal of literal + | Variable of string + | Assignment of { name : string; expr : expr_node } | BinaryExpr of { op : binary_op; left : expr_node; right : expr_node } | UnaryExpr of { op : unary_op; expr : expr_node } @@ -33,19 +35,33 @@ 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 - let ident_s = String.make indent ' ' in + let indent_s = String.make indent ' ' in match expr with - | Literal literal -> ident_s ^ show_literal literal + | Literal literal -> indent_s ^ show_literal literal + | Variable name -> indent_s ^ "Variable " ^ name + | Assignment { name; expr } -> indent_s ^ name ^ " = \n" ^ show_expr expr.expr ~indent:(indent + 2) | BinaryExpr { op; left; 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.expr + indent_s ^ show_binary_op op ^ "\n" ^ show_indented left.expr ^ "\n" + ^ show_indented right.expr + | UnaryExpr { op; expr } -> indent_s ^ show_unary_op op ^ "\n" ^ show_indented expr.expr let show_expr_node expr_node = show_expr expr_node.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_expr_node (pos : Error.code_pos) (expr : expr) : expr_node = { expr; 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 = + Assignment { name; expr } |> make_expr_node pos let make_binary (pos : Error.code_pos) (op : binary_op) (left : expr_node) (right : expr_node) = make_expr_node pos (BinaryExpr { op; left; right }) diff --git a/lib/interpreter.ml b/lib/interpreter.ml index 07423f8..f6d6fa5 100644 --- a/lib/interpreter.ml +++ b/lib/interpreter.ml @@ -1,20 +1,36 @@ let ( let* ) = Result.bind -open Expr +open Environment open Error +open Expr open Stmt 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, runtime_error) result = +let rec interpret_expr (env : environment) (expr : expr_node) : (lox_value, runtime_error) result = let { pos; expr } = expr in match expr with | Literal literal -> Ok (value_of_literal literal) + | Variable name -> ( + let value_opt = Env.get env name in + match value_opt with + | Some x -> Ok x + | None -> + let msg = Printf.sprintf "name \"%s\" is not defined" name in + Error (RuntimeError.make pos msg)) + | Assignment { name; expr } -> + if not (Env.is_defined env name) then + let msg = Printf.sprintf "tried to assign to undefined variable %s" name in + Error (RuntimeError.make pos msg) + else + let* value = interpret_expr env expr in + Env.update env name value; + Ok value | BinaryExpr { op; left; right } -> ( - let* left = interpret_expr left in - let* right = interpret_expr right in + let* left = interpret_expr env left in + let* right = interpret_expr env 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)) @@ -43,7 +59,7 @@ let rec interpret_expr (expr : expr_node) : (lox_value, runtime_error) result = in Error { pos; msg }) | UnaryExpr { op; expr } -> ( - let* expr = interpret_expr expr in + let* expr = interpret_expr env expr in match (op, expr) with | Neg, Number x -> Ok (Number (-.x)) | Not, Bool b -> Ok (Bool (not b)) @@ -54,14 +70,31 @@ let rec interpret_expr (expr : expr_node) : (lox_value, runtime_error) result = in Error (RuntimeError.make pos msg)) -let interpret_stmt (stmt : stmt_node) : (unit, runtime_error) result = +let rec interpret_stmt (env : environment) (stmt : stmt_node) : (unit, runtime_error) result = let { pos; stmt } = stmt in ignore pos; match stmt with + | Expr expr -> + let* _ = interpret_expr env expr in + Ok () | Print expr -> - let* value = interpret_expr expr in + let* value = interpret_expr env expr in print_endline (Value.string_of_lox_value value); Ok () - | Expr expr -> - let* _ = interpret_expr expr in - Ok () + | VarDecl { name; init } -> + let* init = Option.map (interpret_expr env) init |> Option.value ~default:(Ok Nil) in + let success = Env.define env name init in + if success then Ok () + else + let msg = Printf.sprintf "Tried to define %s, but was already defined" name in + Error (RuntimeError.make pos msg) + | Block stmts -> + let env = Env.enter env in + let rec _interpret stmts = + match stmts with + | stmt :: tail -> + let* _ = interpret_stmt env stmt in + _interpret tail + | [] -> Ok () + in + _interpret stmts diff --git a/lib/lexer.ml b/lib/lexer.ml index fd7a3c8..c6cf3b7 100644 --- a/lib/lexer.ml +++ b/lib/lexer.ml @@ -67,7 +67,7 @@ module State = struct let get_lexeme (state : state) (first : int) (last : int) = String.sub state.source first (last - first) - let advance (state : state) : char * state = + let next (state : state) : char * state = let c = state.source.[state.cur_pos] in let state = { state with cur_pos = state.cur_pos + 1 } in let state = @@ -78,21 +78,25 @@ module State = struct in (c, state) + let advance (state : state) : state = + let _, state = next state in + state + let peek (state : state) : char option = if not (is_at_end state) then Some state.source.[state.cur_pos] else None let advance_if (c : char) (state : state) : bool * state = - if peek state = Some c then (true, snd (advance state)) else (false, state) + if peek state = Some c then (true, snd (next state)) else (false, state) let rec advance_until (c : char) (state : state) : bool * state = if is_at_end state then (false, state) else - let c', state = advance state in + let c', state = next state in if c' = c then (true, state) else advance_until c state let rec advance_while (f : char -> bool) (state : state) : state = match peek state with - | Some c when f c -> advance_while f (snd (advance state)) + | Some c when f c -> advance_while f (snd (next state)) | _ -> state (* EOF or no match *) let append_token (pos : code_pos) (token_type : token_type) (state : state) : state = @@ -124,16 +128,16 @@ module State = struct let tt = lexeme |> Hashtbl.find_opt keywords |> Option.value ~default:(Identifier lexeme) in append_token code_pos tt state - let rec parse_block_commend (state : state) : state = + let rec parse_block_comment (state : state) : state = (* "- 2" since we already consumed the "/*" *) let pos = { line = state.line; col = state.col - 2 } in let found, state = advance_until '*' state in - if not found then append_error pos "Unterminated block commend" state + if not found then append_error pos "Unterminated block comment" state else if peek state = Some '/' then - let state = snd @@ advance state in + let state = advance state in let lexeme = get_lexeme state (state.start_pos + 2) (state.cur_pos - 2) in append_token pos (Comment lexeme) state - else parse_block_commend state + else parse_block_comment state let rec tokenize_rec (state : state) : state = let pos = { line = state.line; col = state.col } in @@ -142,7 +146,7 @@ module State = struct if is_at_end state then append_token Eof state else let state = { state with start_pos = state.cur_pos } in - let c, state = advance state in + let c, state = next state in let state = state |> @@ -181,7 +185,7 @@ module State = struct let _, state = advance_until '\n' state in let lexeme = String.trim @@ get_lexeme state start_pos state.cur_pos in append_token (Comment lexeme) state - | Some '*' -> parse_block_commend (snd @@ advance state) + | Some '*' -> parse_block_comment (advance state) | _ -> append_token Slash state) | '"' -> fun state -> diff --git a/lib/lox.ml b/lib/lox.ml index bdd04e7..3556f5f 100644 --- a/lib/lox.ml +++ b/lib/lox.ml @@ -9,31 +9,53 @@ module Stmt = Stmt type lox_error = Error.lox_error -let run (source : string) : (unit, lox_error) result = +let run ?(env : Environment.environment option) ?(debug = false) (source : string) : + (unit, lox_error) result = + let env = Option.value env ~default:(Environment.Env.make ()) in 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_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); *) + let () = + if debug then + let print_tokens () = + print_endline "--- Tokens ---"; + 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 (); + print_endline "--------------"; + print_newline () + in + print_tokens () + else () + in + let* stmts = Error.of_parser_error (Parser.parse tokens) in + let () = + if debug then + let print_statements () = + print_endline "--- Statements ---"; + let f (stmt : Stmt.stmt_node) = print_endline (Stmt.show_stmt stmt.stmt) in + List.iter f stmts; + print_endline "------------------"; + print_newline () + in + print_statements () + else () + in let rec interpret_stmts (stmts : Stmt.stmt_node list) = match stmts with | [] -> Ok () | stmt :: tail -> - let* _ = Interpreter.interpret_stmt stmt in + let* _ = Interpreter.interpret_stmt env stmt in interpret_stmts tail in - interpret_stmts ast |> Error.of_runtimer_error + interpret_stmts stmts |> Error.of_runtimer_error -let runRepl () : unit = +let runRepl ?(debug = false) () : unit = + let env = Environment.Env.make () in try while true do print_string "> "; let line = read_line () in - let result = run line in + let result = run ~env ~debug line in Result.iter_error Error.print_error result done with End_of_file -> () diff --git a/lib/parser.ml b/lib/parser.ml index 1b4c350..cc8e10b 100644 --- a/lib/parser.ml +++ b/lib/parser.ml @@ -10,11 +10,11 @@ type stmt_result = (stmt_node, parser_error) result type expr_result = (expr_node, parser_error) result type state = { tokens : token list } -let is_at_end state = (List.hd !state.tokens).token_type == Eof +let is_at_end state = (List.hd !state.tokens).token_type = Eof let advance state = state := { tokens = List.tl !state.tokens } let next state = - assert (not ((List.hd !state.tokens).token_type == Eof)); + assert (not ((List.hd !state.tokens).token_type = Eof)); let token = List.hd !state.tokens in advance state; token @@ -24,7 +24,7 @@ let peek_tt (state : state ref) : token_type = (peek state).token_type let cur_pos state = (peek state).pos let advance_if state tt = - if peek_tt state == tt then ( + if peek_tt state = tt then ( advance state; true) else false @@ -32,13 +32,23 @@ let advance_if state tt = let consume state tt = if advance_if state tt then Ok () else - Error - (ParserError.make (cur_pos state) - (Printf.sprintf "Expected %s, but got %s" (show_token_type tt) - (show_token_type (peek_tt state)))) + let pos = cur_pos state in + let tt' = peek_tt state in + let msg = Printf.sprintf "Expected %s, but got %s" (show_token_type tt) (show_token_type tt') in + Error (ParserError.make pos msg) + +let consume_identifier state = + match peek_tt state with + | Identifier name -> + advance state; + Ok name + | tt -> + let pos = cur_pos state in + let msg = Printf.sprintf "Expected iedntifier, but got %s" (show_token_type tt) in + Error (ParserError.make pos msg) let matches state tts = - let f = ( == ) (peek_tt state) in + let f = ( = ) (peek_tt state) in Array.fold_left (fun acc tt -> acc || f tt) false tts let collect_chain (state : state ref) (tts : token_type array) @@ -71,9 +81,12 @@ let primary (state : state ref) : expr_result = | Nil -> advance state; Ok (make_nil pos) + | Identifier name -> + advance state; + Ok (make_variable pos name) | tt -> - let msg = Printf.sprintf "Unexpected %s, expected valid expression" (show_token_type tt) in - let pos = (peek state).pos in + advance state; + let msg = Printf.sprintf "Expected valid expression, got %s instead" (show_token_type tt) in Error { msg; pos } let rec grouping (state : state ref) : expr_result = @@ -171,9 +184,40 @@ and equality (state : state ref) : expr_result = let expr = Array.fold_left f expr exprs_tokens in Ok expr -and expression (state : state ref) : expr_result = equality state +and assignment (state : state ref) : expr_result = + let* expr = equality state in + if Equal = peek_tt state then + let pos = (next state).pos in + let* rhs = assignment state in + match expr.expr with + | Variable name -> Ok (make_assignment pos name rhs) + | _ -> + let msg = "Invalid assignment target" in + Error (ParserError.make pos msg) + else Ok expr -let statement (state : state ref) : stmt_result = +and expression (state : state ref) : expr_result = assignment state + +let rec block (state : state ref) : stmt_result = + let pos = cur_pos state in + let* _ = consume state LeftBrace in + let rec collect_stmts state = + if is_at_end state then + let msg = "Unterminated block" in + Error (ParserError.make pos msg) + else + match peek_tt state with + | RightBrace -> Ok [] + | _ -> + let* stmt = declaration state in + let* tail = collect_stmts state in + Ok (stmt :: tail) + in + let* stmts = collect_stmts state in + let* _ = consume state RightBrace in + Ok (make_block pos stmts) + +and statement (state : state ref) : stmt_result = let pos = cur_pos state in match peek_tt state with | Print -> @@ -182,12 +226,32 @@ let statement (state : state ref) : stmt_result = let* _ = consume state Semicolon in let stmt = make_print pos expr in Ok stmt - | tt -> - advance state; - let msg = - Printf.sprintf "Statement stating with %s not yet implemented" (show_token_type tt) - in - Error (ParserError.make pos msg) + | LeftBrace -> block state + | _ -> + let* expr = expression state in + let* _ = consume state Semicolon in + let stmt = make_expr_stmt pos expr in + Ok stmt + +and var_declaration (state : state ref) : stmt_result = + let pos = cur_pos state in + (* consume var token *) + assert ((next state).token_type = Var); + let* name = consume_identifier state in + let* init = + if Equal = peek_tt state then + (* found =, parsing initialiser *) + 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 + Ok (make_var_decl pos name init) + +and declaration (state : state ref) : stmt_result = + match peek_tt state with Var -> var_declaration state | _ -> statement state let rec synchronise (state : state ref) = match peek_tt state with @@ -198,19 +262,20 @@ let rec synchronise (state : state ref) = synchronise state let rec parse_impl (state : state ref) : parse_result = - let result = statement state in - match result with - | Ok stmt when peek_tt state == Eof -> Ok [ stmt ] - | Ok stmt -> - print_endline (show_stmt stmt.stmt); - let* stmts = parse_impl state in - Ok (stmt :: stmts) - | Error e -> ( - synchronise state; - if peek_tt state == Eof then Error [ e ] - else - let tail_result = parse_impl state in - match tail_result with Ok _ -> Error [ e ] | Error es -> Error (e :: es)) + if peek_tt state = Eof then Ok [] + else + let result = declaration state in + match result with + | Ok stmt -> + let* stmts = parse_impl state in + Ok (stmt :: stmts) + | Error e -> ( + print_endline e.msg; + synchronise state; + if peek_tt state = Eof then Error [ e ] + else + let tail_result = parse_impl state in + match tail_result with Ok _ -> Error [ e ] | Error es -> Error (e :: es)) let parse (tokens : token list) : parse_result = (* filter out all the comment tokens *) diff --git a/lib/stmt.ml b/lib/stmt.ml index 90c8891..bcaca44 100644 --- a/lib/stmt.ml +++ b/lib/stmt.ml @@ -1,13 +1,44 @@ -type stmt = Expr of Expr.expr_node | Print of Expr.expr_node +open Expr + +type stmt = + | Expr of expr_node + | Print of expr_node + | VarDecl of { name : string; init : expr_node option } + | Block of stmt_node list + and stmt_node = { stmt : stmt; pos : Error.code_pos } -let show_stmt stmt = - match stmt with Expr expr -> Expr.show_expr expr.expr | Print expr -> Expr.show_expr expr.expr +let rec show_stmt ?(indent = 0) stmt = + let indent_s = String.make indent ' ' in + match stmt with + | Expr expr -> indent_s ^ "Expr\n" ^ show_expr ~indent:(indent + 2) expr.expr + | Print expr -> indent_s ^ "Print\n" ^ show_expr ~indent:(indent + 2) expr.expr + | VarDecl { name; init } -> ( + indent_s ^ "Var " ^ name + ^ + match init with Some init -> " = \n" ^ show_expr ~indent:(indent + 2) init.expr | None -> "") + | Block stmts -> + let stmts_s = + List.fold_left + (fun acc stmt -> acc ^ show_stmt ~indent:(indent + 2) stmt.stmt ^ "\n") + "" stmts + in + "Block" ^ stmts_s ^ "End" -let make_expr_stmt (pos : Error.code_pos) (expr : Expr.expr_node) : stmt_node = +let show_stmt_node stmt_node = show_stmt stmt_node.stmt + +let make_expr_stmt (pos : Error.code_pos) (expr : expr_node) : stmt_node = let stmt = Expr expr in { stmt; pos } -let make_print (pos : Error.code_pos) (expr : Expr.expr_node) : stmt_node = +let make_print (pos : Error.code_pos) (expr : expr_node) : stmt_node = let stmt = Print expr in { stmt; pos } + +let make_var_decl (pos : Error.code_pos) (name : string) (init : expr_node option) = + let stmt = VarDecl { name; init } in + { stmt; pos } + +let make_block (pos : Error.code_pos) (stmts : stmt_node list) : stmt_node = + let stmt = Block stmts in + { stmt; pos }