feat: impl function call

This commit is contained in:
monoid 2025-01-29 18:07:47 +09:00
parent 122808922d
commit 57d1cc73dd
3 changed files with 32 additions and 7 deletions

View file

@ -1,4 +1,5 @@
open Calc;; open Calc;;
let main () = let main () =
let input = Sys.argv.(1) in let input = Sys.argv.(1) in

View file

@ -11,7 +11,7 @@ and scope = {
bindings: value_type VariableBindingMap.t; bindings: value_type VariableBindingMap.t;
} }
and function_type = { and function_type = {
name: string; argname: string;
body: Parser.expr_tree; body: Parser.expr_tree;
scope: scope; scope: scope;
} }
@ -28,6 +28,8 @@ let rec eval_expr (scope: scope) (expr: Parser.expr_tree): value_type =
eval_bin_op_expr scope op left_expr right_expr eval_bin_op_expr scope op left_expr right_expr
| Parser.MonoOpExpr (_op, _expr) -> | Parser.MonoOpExpr (_op, _expr) ->
failwith "Not implemented" failwith "Not implemented"
| Parser.CallExpr (Parser.Call (func_expr, arg_expr)) ->
eval_call_expr scope func_expr arg_expr
| Parser.Identifier(name) -> | Parser.Identifier(name) ->
let rec find_binding scope = let rec find_binding scope =
match scope with match scope with
@ -38,6 +40,14 @@ let rec eval_expr (scope: scope) (expr: Parser.expr_tree): value_type =
| None -> find_binding s.parent in | None -> find_binding s.parent in
find_binding (Some scope) find_binding (Some scope)
| Parser.Number(n) -> Int n | Parser.Number(n) -> Int n
and eval_call_expr scope func_expr arg_expr =
let func = eval_expr scope func_expr in
let arg = eval_expr scope arg_expr in
(match func with
| Fun f ->
let new_scope = { parent = Some f.scope; bindings = VariableBindingMap.add f.argname arg f.scope.bindings } in
eval_expr new_scope f.body
| _ -> failwith "Type error")
and eval_if_expr scope cond_expr then_expr else_expr = and eval_if_expr scope cond_expr then_expr else_expr =
let cond = eval_expr scope cond_expr in let cond = eval_expr scope cond_expr in
(match cond with (match cond with
@ -48,7 +58,7 @@ and eval_let_expr scope name value_expr in_expr =
let new_scope = { scope with bindings = VariableBindingMap.add name value scope.bindings } in let new_scope = { scope with bindings = VariableBindingMap.add name value scope.bindings } in
eval_expr new_scope in_expr eval_expr new_scope in_expr
and eval_fun_expr scope name body_expr = and eval_fun_expr scope name body_expr =
Fun { name = name; body = body_expr; scope = scope } Fun { argname = name; body = body_expr; scope = scope }
and eval_bin_op_expr scope op left_expr right_expr = and eval_bin_op_expr scope op left_expr right_expr =
let left = eval_expr scope left_expr in let left = eval_expr scope left_expr in
let right = eval_expr scope right_expr in let right = eval_expr scope right_expr in

View file

@ -71,8 +71,9 @@ BNF:
let_expr ::= let identifier = expr in expr let_expr ::= let identifier = expr in expr
fun_expr ::= fun identifier -> expr fun_expr ::= fun identifier -> expr
if_expr ::= if expr then expr else expr if_expr ::= if expr then expr else expr
level0 ::= (expr) | identifier | number factor ::= (expr) | identifier | number
level1 ::= level0 | level1 + level0 | level1 - level0 call_expr ::= factor | factor factor
level1 ::= call_expr | level1 + call_expr | level1 - call_expr
level2 ::= level2 * level1 | level2 / level1 | level2 % level1 | level1 level2 ::= level2 * level1 | level2 / level1 | level2 % level1 | level1
level3 ::= level2 ^ level3 | level2 level3 ::= level2 ^ level3 | level2
expr ::= let_expr | fun_expr | if_expr | level3 expr ::= let_expr | fun_expr | if_expr | level3
@ -81,10 +82,12 @@ BNF:
type let_expr_tree = Let of string * expr_tree * expr_tree type let_expr_tree = Let of string * expr_tree * expr_tree
and fun_expr_tree = Fun of string * expr_tree and fun_expr_tree = Fun of string * expr_tree
and if_expr_tree = If of expr_tree * expr_tree * expr_tree and if_expr_tree = If of expr_tree * expr_tree * expr_tree
and call_expr_tree = Call of expr_tree * expr_tree
and expr_tree = and expr_tree =
| LetExpr of let_expr_tree | LetExpr of let_expr_tree
| FunExpr of fun_expr_tree | FunExpr of fun_expr_tree
| IfExpr of if_expr_tree | IfExpr of if_expr_tree
| CallExpr of call_expr_tree
| BinOpExpr of Lexer.op_type * expr_tree * expr_tree | BinOpExpr of Lexer.op_type * expr_tree * expr_tree
| MonoOpExpr of Lexer.op_type * expr_tree | MonoOpExpr of Lexer.op_type * expr_tree
| Identifier of string | Identifier of string
@ -96,6 +99,7 @@ let expr2str (e: expr_tree): string =
| LetExpr (Let (id, e1, e2)) -> Printf.sprintf "let %s = %s in\n %s" id (aux e1) (aux e2) | LetExpr (Let (id, e1, e2)) -> Printf.sprintf "let %s = %s in\n %s" id (aux e1) (aux e2)
| FunExpr (Fun (id, e)) -> Printf.sprintf "fun %s -> %s" id (aux e) | FunExpr (Fun (id, e)) -> Printf.sprintf "fun %s -> %s" id (aux e)
| IfExpr (If (e1, e2, e3)) -> Printf.sprintf "if %s then %s else %s" (aux e1) (aux e2) (aux e3) | IfExpr (If (e1, e2, e3)) -> Printf.sprintf "if %s then %s else %s" (aux e1) (aux e2) (aux e3)
| CallExpr (Call (e1, e2)) -> Printf.sprintf "%s %s" (aux e1) (aux e2)
| BinOpExpr (op, e1, e2) -> Printf.sprintf "%s %s %s" (aux e1) (Lexer.op2str op) (aux e2) | BinOpExpr (op, e1, e2) -> Printf.sprintf "%s %s %s" (aux e1) (Lexer.op2str op) (aux e2)
| MonoOpExpr (op, e) -> Printf.sprintf "%s %s" (Lexer.op2str op) (aux e) | MonoOpExpr (op, e) -> Printf.sprintf "%s %s" (Lexer.op2str op) (aux e)
| Identifier id -> id | Identifier id -> id
@ -132,7 +136,7 @@ and parse_if_expr (): if_expr_tree parser =
let* _ = match_token (Lexer.Keyword Lexer.Else) in let* _ = match_token (Lexer.Keyword Lexer.Else) in
let* e3 = expr() in let* e3 = expr() in
return (If (e1, e2, e3)) return (If (e1, e2, e3))
and parse_level0 (): expr_tree parser = and parse_factor (): expr_tree parser =
let* tt = peek_token in let* tt = peek_token in
match tt.token_type with match tt.token_type with
| Lexer.Identifier x -> | Lexer.Identifier x ->
@ -147,14 +151,24 @@ and parse_level0 (): expr_tree parser =
let* _ = match_token Lexer.RParen in let* _ = match_token Lexer.RParen in
return e return e
| _ -> stop | _ -> stop
and parse_call_expr (): expr_tree parser =
let* e1 = parse_factor() in
let rec aux e1 =
let* c = peek_token in
match c.token_type with
| Lexer.Identifier _ | Lexer.Digit _ | Lexer.LParen ->
let* e2 = parse_factor() in
aux (CallExpr (Call (e1, e2)))
| _ -> return e1 in
aux e1
and parse_level1 (): expr_tree parser = and parse_level1 (): expr_tree parser =
let* e1 = parse_level0() in let* e1 = parse_call_expr() in
let rec aux e1 = let rec aux e1 =
let* c = peek_token in let* c = peek_token in
match c.token_type with match c.token_type with
| Lexer.Op op when op = Lexer.Add || op = Lexer.Sub -> | Lexer.Op op when op = Lexer.Add || op = Lexer.Sub ->
let* _ = next_token in let* _ = next_token in
let* e2 = parse_level0() in let* e2 = parse_call_expr() in
aux (BinOpExpr (op, e1, e2)) aux (BinOpExpr (op, e1, e2))
| _ -> return e1 in | _ -> return e1 in
aux e1 aux e1