mg/mlox
1
0
Fork 0
mirror of https://github.com/MorizzG/MLox.git synced 2025-12-06 04:22:41 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

implemented return by rewriting interpreter result

Browse source
This commit is contained in:
Moritz Gmeiner 2024-08-28 22:55:15 +02:00
commit dee73dea20
16 changed files with 191 additions and 239 deletions
Download patch file Download diff file Expand all files Collapse all files

21
lib/error.ml
View file

@ -4,9 +4,9 @@ type lexer_error = { pos : code_pos; msg : string }
module LexerError = struct
type t = lexer_error
let make (pos : code_pos) (msg : string) : lexer_error = { pos; msg }
let make (pos : code_pos) (msg : string) : t = { pos; msg }
let show (e : lexer_error) =
let show (e : t) =
Printf.sprintf "LexerError at line %d, column %d: %s" e.pos.line e.pos.col e.msg
end
@ -15,27 +15,22 @@ type parser_error = { pos : code_pos; msg : string }
module ParserError = struct
type t = parser_error
let make (pos : code_pos) (msg : string) : parser_error = { pos; msg }
let make (pos : code_pos) (msg : string) : t = { pos; msg }
let show (e : parser_error) =
let show (e : t) =
Printf.sprintf "ParserError at line %d, column %d: %s" e.pos.line e.pos.col e.msg
end
(* type runtime_error = { pos : code_pos; msg : string; type_ : runtime_error_type } *)
type runtime_error = Error of { pos : code_pos; msg : string } | Break | Continue
type runtime_error = { pos : code_pos; msg : string }
module RuntimeError = struct
type t = parser_error
type t = runtime_error
let make (pos : code_pos) (msg : string) : runtime_error = Error { pos; msg }
let break () : runtime_error = Break
let continue () : runtime_error = Continue
let make (pos : code_pos) (msg : string) : t = { pos; msg }
let show (e : runtime_error) =
match e with
| Error { pos; msg } ->
let show ({ pos; msg } : t) =
Printf.sprintf "RuntimeError at line %d, column %d: %s" pos.line pos.col msg
| Break | Continue -> assert false
end
type lox_error =

157
lib/interpreter.ml
View file

@ -1,5 +1,3 @@
let ( let* ) = Result.bind
open Environment
open Error
open Expr
@ -9,22 +7,69 @@ 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 (env : environment) (expr_node : expr_node) :
(lox_value, runtime_error) result =
type 'a interpreter_result =
| Ok of 'a
| Break
| Continue
| Return of lox_value
| Error of runtime_error
module InterpreterResult = struct
type 'a t = 'a interpreter_result
let ok value = Ok value
let break () = Break
let continue () = Continue
let return (value : lox_value) = Return value
let error e = Error e
let map f result =
match result with
| Ok x -> f x |> ok
| Break -> Break
| Continue -> Continue
| Return _ as r -> r
| Error _ as e -> e
let map_error f result =
match result with
| Error e -> f e |> error
| Ok _ as x -> x
| Break -> Break
| Continue -> Continue
| Return _ as r -> r
let bind result f =
match result with
| Ok value -> f value
| Break -> Break
| Continue -> Continue
| Return _ as r -> r
| Error _ as e -> e
end
open InterpreterResult
let ( let* ) = InterpreterResult.bind
type expr_result = lox_value interpreter_result
type stmt_result = unit interpreter_result
let rec interpret_expr (env : environment) (expr_node : expr_node) : lox_value interpreter_result =
let { pos; expr } = expr_node in
match expr with
| Literal literal -> value_of_literal literal |> Result.ok
| Literal literal -> value_of_literal literal |> ok
| 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
RuntimeError.make pos msg |> Result.error)
RuntimeError.make pos msg |> error)
| Assignment { name; expr } ->
if not (Env.is_defined env name) then
let msg = Printf.sprintf "tried to assign to undefined variable %s" name in
RuntimeError.make pos msg |> Result.error
RuntimeError.make pos msg |> error
else
let* value = interpret_expr env expr in
Env.update env name value;
@ -32,44 +77,44 @@ let rec interpret_expr (env : environment) (expr_node : expr_node) :
| Unary { op; expr } -> (
let* expr = interpret_expr env expr in
match (op, expr) with
| Neg, Number x -> Number (-.x) |> Result.ok
| Not, value -> Bool (lox_value_to_bool value |> not) |> Result.ok
| Neg, Number x -> Number (-.x) |> ok
| Not, value -> Bool (lox_value_to_bool value |> not) |> ok
| _, _ ->
let msg =
Printf.sprintf "Invalid operant of type %s to operator %s"
(type_string_of_lox_value expr) (show_unary_op op)
in
RuntimeError.make pos msg |> Result.error)
RuntimeError.make pos msg |> error)
| Binary { op; left; right } -> (
let* left = interpret_expr env left in
let* right = interpret_expr env right in
match (left, op, right) with
| String a, Plus, String b -> String (a ^ b) |> Result.ok
| Number x, Plus, Number y -> Number (x +. y) |> Result.ok
| Number x, Minus, Number y -> Number (x -. y) |> Result.ok
| Number x, Mul, Number y -> Number (x *. y) |> Result.ok
| String a, Plus, String b -> String (a ^ b) |> ok
| Number x, Plus, Number y -> Number (x +. y) |> ok
| Number x, Minus, Number y -> Number (x -. y) |> ok
| Number x, Mul, Number y -> Number (x *. y) |> ok
| Number x, Div, Number y ->
if y <> 0. then Number (x /. y) |> Result.ok
if y <> 0. then Number (x /. y) |> ok
else
let msg = "Division by 0" in
RuntimeError.make pos msg |> Result.error
| Bool b, And, Bool c -> Bool (b && c) |> Result.ok
| Bool b, Or, Bool c -> Bool (b || c) |> Result.ok
RuntimeError.make pos msg |> error
| Bool b, And, Bool c -> Bool (b && c) |> ok
| Bool b, Or, Bool c -> Bool (b || c) |> ok
| _, Equal, _ -> Ok (Bool (left = right))
| Number x, Greater, Number y -> Bool (x > y) |> Result.ok
| Number x, GreaterEqual, Number y -> Bool (x >= y) |> Result.ok
| Number x, Less, Number y -> Bool (x < y) |> Result.ok
| Number x, LessEqual, Number y -> Bool (x <= y) |> Result.ok
| String a, Greater, String b -> Bool (a > b) |> Result.ok
| String a, GreaterEqual, String b -> Bool (a >= b) |> Result.ok
| String a, Less, String b -> Bool (a < b) |> Result.ok
| String a, LessEqual, String b -> Bool (a <= b) |> Result.ok
| Number x, Greater, Number y -> Bool (x > y) |> ok
| Number x, GreaterEqual, Number y -> Bool (x >= y) |> ok
| Number x, Less, Number y -> Bool (x < y) |> ok
| Number x, LessEqual, Number y -> Bool (x <= y) |> ok
| String a, Greater, String b -> Bool (a > b) |> ok
| String a, GreaterEqual, String b -> Bool (a >= b) |> ok
| String a, Less, String b -> Bool (a < b) |> ok
| String a, LessEqual, String b -> Bool (a <= b) |> ok
| _, _, _ ->
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
RuntimeError.make pos msg |> Result.error)
RuntimeError.make pos msg |> error)
| Logical { op; left; right } -> (
let* left = interpret_expr env left in
match (op, lox_value_to_bool left) with
@ -77,56 +122,60 @@ let rec interpret_expr (env : environment) (expr_node : expr_node) :
| _ -> 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 f (acc : lox_value list interpreter_result) arg =
let* acc = acc in
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
match callee with
| Function (NativeFunction { name; arity; fn }) ->
| NativeFunction { name; arity; fn } -> (
let args_len = List.length args in
if args_len <> arity then
let msg =
Printf.sprintf "Native Function %s has arity %d, but was called with %d args" name
args_len arity
in
RuntimeError.make pos msg |> Result.error
else fn args |> Result.map_error (RuntimeError.make pos)
| Function (LoxFunction { name; arity; arg_names; body }) ->
RuntimeError.make pos msg |> error
else
match fn args with Ok value -> Ok value | Error s -> RuntimeError.make pos s |> error)
| Function { name; arity; arg_names; body } -> (
let args_len = List.length args in
if args_len <> arity then
let msg =
Printf.sprintf "Function %s has arity %d, but was called with %d args" name args_len
arity
in
RuntimeError.make pos msg |> Result.error
RuntimeError.make pos msg |> error
else
let env = Env.push_frame env in
let () =
List.iter2 (fun name value -> assert (Env.define env name value)) arg_names args
in
let* () = interpret_stmt env body in
Ok Nil
let result = interpret_stmt env body in
match result with
| Ok () -> Ok Nil
| Return value -> Ok value
| Error _ as e -> e
| _ -> assert false)
| _ ->
ignore args;
let msg = Printf.sprintf "%s object is not callable" (type_string_of_lox_value callee) in
RuntimeError.make pos msg |> Result.error)
RuntimeError.make pos msg |> error)
and interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runtime_error) result =
let { pos; stmt } = stmt_node in
ignore pos;
and interpret_stmt (env : environment) (stmt_node : stmt_node) : unit interpreter_result =
let { stmt; pos } = stmt_node in
match stmt with
| Expr expr ->
let* value = interpret_expr env expr in
ignore value;
Ok ()
| Break -> RuntimeError.break () |> Result.error
| Continue -> RuntimeError.continue () |> Result.error
| Break -> break ()
| Continue -> continue ()
| Return expr ->
let* value = interpret_expr env expr in
Return value
| Print expr ->
let* value = interpret_expr env expr in
print_endline (Value.string_of_lox_value value);
@ -139,7 +188,7 @@ and interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runtime_
let msg =
Printf.sprintf "Tried to define %s, but a variable of that name was already defined" name
in
RuntimeError.make pos msg |> Result.error
RuntimeError.make pos msg |> error
| FunDecl { name; arg_names; body } ->
let fn = make_lox_function name arg_names body in
let success = Env.define env name fn in
@ -149,7 +198,7 @@ and interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runtime_
Printf.sprintf
"Tried to define function %s, but a variable of that name was already defined" name
in
RuntimeError.make pos msg |> Result.error
RuntimeError.make pos msg |> error
| Block stmts ->
let env = Env.enter env in
let rec _interpret stmts =
@ -171,9 +220,9 @@ and interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runtime_
if cond then
let result = interpret_stmt env body in
match result with
| Ok () | Error Continue -> interpret_stmt env stmt_node
| Error Break -> Ok ()
| Error e -> Error e
| Ok () | Continue -> interpret_stmt env stmt_node
| Break -> Ok ()
| other -> other
else Ok ()
| For { init; cond; update; body } ->
let env = Env.enter env in
@ -182,7 +231,7 @@ and interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runtime_
cond
|> Option.map (interpret_expr env)
|> Option.value ~default:(Ok (Value.Bool true))
|> Result.map Value.lox_value_to_bool
|> map Value.lox_value_to_bool
in
let do_update () =
update |> Option.map (interpret_expr env) |> Option.value ~default:(Ok Value.Nil)
@ -192,12 +241,12 @@ and interpret_stmt (env : environment) (stmt_node : stmt_node) : (unit, runtime_
if cond then
let result = interpret_stmt env body in
match result with
| Ok () | Error Continue ->
| Ok () | Continue ->
let* value = do_update () in
ignore value;
loop ()
| Error Break -> Ok ()
| Error e -> Error e
| Break -> Ok ()
| other -> other
else Ok ()
in
loop ()

8
lib/lox.ml
View file

@ -49,9 +49,11 @@ let run ?(env : Environment.environment option) ?(debug = false) (source : strin
let rec interpret_stmts (stmts : Stmt.stmt_node list) =
match stmts with
| [] -> Ok ()
| stmt :: tail ->
let* () = Interpreter.interpret_stmt env stmt in
interpret_stmts tail
| stmt :: tail -> (
match Interpreter.interpret_stmt env stmt with
| Ok () -> interpret_stmts tail
| Error e -> Error e
| _ -> assert false)
in
interpret_stmts stmts |> Error.of_runtimer_error

2
lib/loxstd.ml
View file

@ -23,6 +23,6 @@ let exit : native_function =
{ name = "exit"; arity = 1; fn }
let init_std (env : environment) =
let register_fn fn = Env.define_global env fn.name (Function (NativeFunction fn)) in
let register_fn fn = Env.define_global env fn.name (NativeFunction fn) in
let _ = List.map register_fn [ clock; exit ] in
()

5
lib/stmt.ml
View file

@ -5,6 +5,7 @@ type stmt =
| Expr of expr_node
| Break
| Continue
| Return of expr_node
| Print of expr_node
| VarDecl of { name : string; init : expr_node option }
| FunDecl of { name : string; arg_names : string list; body : stmt_node }
@ -28,6 +29,9 @@ let rec show_stmt ?(indent = 0) stmt =
| Expr expr -> indent_s ^ "Expr\n" ^ show_expr_ind expr.expr
| Break -> indent_s ^ "Break"
| Continue -> indent_s ^ "Continue"
| Return expr ->
let expr_s = show_expr_ind expr.expr in
"Return\n" ^ expr_s
| Print expr -> indent_s ^ "Print\n" ^ show_expr_ind expr.expr
| VarDecl { name; init } ->
let init_s = match init with Some init -> " = \n" ^ show_expr_ind init.expr | None -> "" in
@ -90,6 +94,7 @@ let make_stmt_node (pos : code_pos) (stmt : stmt) : stmt_node = { stmt; pos }
let make_expr_stmt (pos : code_pos) (expr : expr_node) : stmt_node = Expr expr |> make_stmt_node pos
let make_break (pos : code_pos) : stmt_node = Break |> make_stmt_node pos
let make_continue (pos : code_pos) : stmt_node = Continue |> make_stmt_node pos
let make_return (pos : code_pos) (expr : expr_node) = Return expr |> make_stmt_node pos
let make_print (pos : code_pos) (expr : expr_node) : stmt_node = Print expr |> make_stmt_node pos
let make_var_decl (pos : code_pos) (name : string) (init : expr_node option) =

23
lib/value.ml
View file

@ -1,6 +1,7 @@
type lox_function = {
name : string;
arity : int;
(* env : Environment.environment; *)
arg_names : string list;
body : Stmt.stmt_node; [@printer fun fmt _ -> fprintf fmt "<body>"]
}
@ -13,16 +14,19 @@ type native_function = {
}
[@@deriving show { with_path = false }]
and function_ = NativeFunction of native_function | LoxFunction of lox_function
[@@deriving show { with_path = false }]
and lox_value = Function of function_ | String of string | Number of float | Bool of bool | Nil
and lox_value =
| Function of lox_function
| NativeFunction of native_function
| 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
| Function (NativeFunction { name; arity; _ }) -> Printf.sprintf "<native fn %s/%d>" name arity
| Function (LoxFunction { name; arity; _ }) -> Printf.sprintf "<fn %s/%d>" name arity
| Function { name; arity; _ } -> Printf.sprintf "<fn %s/%d>" name arity
| NativeFunction { name; arity; _ } -> Printf.sprintf "<native fn %s/%d>" name arity
| String s -> s
| Number x -> if Float.is_integer x then string_of_int (Int.of_float x) else string_of_float x
| Bool b -> string_of_bool b
@ -30,8 +34,8 @@ let string_of_lox_value lox_value =
let type_string_of_lox_value lox_value =
match lox_value with
| Function (NativeFunction _) -> "NativeFunction"
| Function (LoxFunction _) -> "Function"
| Function _ -> "Function"
| NativeFunction _ -> "NativeFunction"
| String _ -> "String"
| Number _ -> "Number"
| Bool _ -> "Bool"
@ -42,5 +46,4 @@ let lox_value_to_bool lox_value = match lox_value with Bool b -> b | Nil -> fals
let make_lox_function (name : string) (arg_names : string list) (body : Stmt.stmt_node) : lox_value
=
let arity = List.length arg_names in
let fn = LoxFunction { name; arity; arg_names; body } in
Function fn
Function { name; arity; arg_names; body }

4
lox.t/expressions/evaluate.lox
View file

@ -1,4 +0,0 @@
// Note: This is just for the expression evaluating chapter which evaluates an
// expression directly.
(5 - (3 - 1)) + -1
// expect: 2

3
lox.t/expressions/parse.lox
View file

@ -1,3 +0,0 @@
// Note: This is just for the expression parsing chapter which prints the AST.
(5 - (3 - 1)) + -1
// expect: (+ (group (- 5.0 (group (- 3.0 1.0)))) (- 1.0))

6
lox.t/fib.lox
View file

@ -1,6 +0,0 @@
fun fib(n) {
if (n < 2) return n;
return fib(n - 2) + fib(n - 1);
}
print fib(35); // expect: 9227465

114
lox.t/run.t
View file

@ -1,20 +1,7 @@
$ for lox_file in *.lox **/*.lox; do
> mlox $lox_file || echo $lox_file failed
> done
unexpected_character.lox failed
string/unterminated.lox failed
file empty_file.lox
$ mlox empty_file.lox
file fib.lox
$ mlox fib.lox
9227465
file precedence.lox
$ mlox precedence.lox
14
@ -364,14 +351,6 @@ file continue/while.lox
9
file expressions/evaluate.lox
$ mlox expressions/evaluate.lox
file expressions/parse.lox
$ mlox expressions/parse.lox
file field/call_function_field.lox
$ mlox field/call_function_field.lox
@ -476,7 +455,8 @@ $ mlox for/return_closure.lox
file for/return_inside.lox
$ mlox for/return_inside.lox
$ mlox for/return_inside.lox
i
file for/scope.lox
@ -510,7 +490,21 @@ file for/statement_initializer.lox
file for/syntax.lox
$ mlox for/syntax.lox
$ mlox for/syntax.lox
1
2
3
0
1
2
done
0
1
0
1
2
0
1
file for/var_in_body.lox
@ -538,8 +532,9 @@ file function/extra_arguments.lox
file function/local_mutual_recursion.lox
$ mlox function/local_mutual_recursion.lox
$ mlox function/local_mutual_recursion.lox
RuntimeError at line 4, column 11: name "isOdd" is not defined
[1]
file function/local_recursion.lox
$ mlox function/local_recursion.lox
@ -559,15 +554,27 @@ file function/missing_comma_in_parameters.lox
file function/mutual_recursion.lox
$ mlox function/mutual_recursion.lox
$ mlox function/mutual_recursion.lox
true
true
file function/nested_call_with_arguments.lox
$ mlox function/nested_call_with_arguments.lox
$ mlox function/nested_call_with_arguments.lox
hello world
file function/parameters.lox
$ mlox function/parameters.lox
$ mlox function/parameters.lox
0
1
3
6
10
15
21
28
36
file function/print.lox
@ -577,7 +584,8 @@ file function/print.lox
file function/recursion.lox
$ mlox function/recursion.lox
$ mlox function/recursion.lox
21
file function/too_many_arguments.lox
@ -1079,23 +1087,29 @@ $ mlox regression/394.lox
file return/after_else.lox
$ mlox return/after_else.lox
$ mlox return/after_else.lox
ok
file return/after_if.lox
$ mlox return/after_if.lox
$ mlox return/after_if.lox
ok
file return/after_while.lox
$ mlox return/after_while.lox
$ mlox return/after_while.lox
ok
file return/at_top_level.lox
$ mlox return/at_top_level.lox
$ mlox return/at_top_level.lox
found 1 ParserError:
ParserError at line 1, column 0: Can use return only in functions
[1]
file return/in_function.lox
$ mlox return/in_function.lox
$ mlox return/in_function.lox
ok
file return/in_method.lox
@ -1103,31 +1117,8 @@ $ mlox return/in_method.lox
file return/return_nil_if_no_value.lox
$ mlox return/return_nil_if_no_value.lox
file scanning/identifiers.lox
$ mlox scanning/identifiers.lox
file scanning/keywords.lox
$ mlox scanning/keywords.lox
file scanning/numbers.lox
$ mlox scanning/numbers.lox
file scanning/punctuators.lox
$ mlox scanning/punctuators.lox
file scanning/strings.lox
$ mlox scanning/strings.lox
file scanning/whitespace.lox
$ mlox scanning/whitespace.lox
$ mlox return/return_nil_if_no_value.lox
nil
file string/error_after_multiline.lox
@ -1403,7 +1394,8 @@ $ mlox while/return_closure.lox
file while/return_inside.lox
$ mlox while/return_inside.lox
$ mlox while/return_inside.lox
i
file while/syntax.lox

12
lox.t/scanning/identifiers.lox
View file

@ -1,12 +0,0 @@
andy formless fo _ _123 _abc ab123
abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_
// expect: IDENTIFIER andy null
// expect: IDENTIFIER formless null
// expect: IDENTIFIER fo null
// expect: IDENTIFIER _ null
// expect: IDENTIFIER _123 null
// expect: IDENTIFIER _abc null
// expect: IDENTIFIER ab123 null
// expect: IDENTIFIER abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_ null
// expect: EOF null

18
lox.t/scanning/keywords.lox
View file

@ -1,18 +0,0 @@
and class else false for fun if nil or return super this true var while
// expect: AND and null
// expect: CLASS class null
// expect: ELSE else null
// expect: FALSE false null
// expect: FOR for null
// expect: FUN fun null
// expect: IF if null
// expect: NIL nil null
// expect: OR or null
// expect: RETURN return null
// expect: SUPER super null
// expect: THIS this null
// expect: TRUE true null
// expect: VAR var null
// expect: WHILE while null
// expect: EOF null

12
lox.t/scanning/numbers.lox
View file

@ -1,12 +0,0 @@
123
123.456
.456
123.
// expect: NUMBER 123 123.0
// expect: NUMBER 123.456 123.456
// expect: DOT . null
// expect: NUMBER 456 456.0
// expect: NUMBER 123 123.0
// expect: DOT . null
// expect: EOF null

21
lox.t/scanning/punctuators.lox
View file

@ -1,21 +0,0 @@
(){};,+-*!===<=>=!=<>/.
// expect: LEFT_PAREN ( null
// expect: RIGHT_PAREN ) null
// expect: LEFT_BRACE { null
// expect: RIGHT_BRACE } null
// expect: SEMICOLON ; null
// expect: COMMA , null
// expect: PLUS + null
// expect: MINUS - null
// expect: STAR * null
// expect: BANG_EQUAL != null
// expect: EQUAL_EQUAL == null
// expect: LESS_EQUAL <= null
// expect: GREATER_EQUAL >= null
// expect: BANG_EQUAL != null
// expect: LESS < null
// expect: GREATER > null
// expect: SLASH / null
// expect: DOT . null
// expect: EOF null

6
lox.t/scanning/strings.lox
View file

@ -1,6 +0,0 @@
""
"string"
// expect: STRING ""
// expect: STRING "string" string
// expect: EOF null

12
lox.t/scanning/whitespace.lox
View file

@ -1,12 +0,0 @@
space tabs newlines
end
// expect: IDENTIFIER space null
// expect: IDENTIFIER tabs null
// expect: IDENTIFIER newlines null
// expect: IDENTIFIER end null
// expect: EOF null