Seperate apply from eval

This commit is contained in:
백현웅 2022-02-19 23:17:10 +09:00
parent 71bc70d3bc
commit 34eeff4a01

57
eval.ml
View file

@ -219,9 +219,9 @@ let binop op l r =
exception Unbound of string
(* TODO: refactor eval, split function into parts *)
let rec eval env ast =
let rec aux = function
let aux = eval env in (* eval with current env *)
match ast with
| Nothing -> Nop
| Nint n -> Int n
| Nfloat n -> Float n
@ -241,36 +241,14 @@ let rec eval env ast =
| Unary (op, v) -> unary op (aux v)
| Binop (l, op, r) -> binop op (aux l) (aux r)
| If (co, th, el) ->
begin match aux co with
| Bool true -> aux th
| Bool false -> aux el
| v -> raise @@ Type.Invalid (Value.typeof v)
end
| Apply (v, args) ->
begin match aux v with
| Function (itself, var, e, env) as f ->
begin match args with
| [] -> f
| a::args ->
let env =
(* binding itself into env for recursion *)
Option.fold
~none: env ~some: (fun v -> Env.bind (v, f) env)
itself
|> Env.bind (var, aux a)
in
eval env @@ Apply (e, args)
end
| External f ->
let args = List.map aux args in
External.apply f args
| v ->
if args = []
then v
else raise @@ Type.Invalid (Value.typeof v)
end
| Apply (v, args) -> apply v args env
| Set_binop_pre (op, l) ->
let l =
@ -290,9 +268,32 @@ let rec eval env ast =
| None -> String "left"
| Some a -> String (Parser.assoc_to_string a))
| _ -> failwith "Eval.eval"
in
aux ast
(* apply args to result of expr *)
and apply expr args env =
match eval env expr with
| Function (itself, var, e, env) as f ->
begin match args with
| [] -> f
| a::args ->
let value = eval env a in
let env = (* binding itself into env for recursion *)
itself
|> Option.fold
~none: env
~some: (fun n -> Env.bind (n, f) env)
|> Env.bind (var, value)
in
eval env @@ Apply (e, args)
end
| External f ->
let args = List.map (eval env) args in
External.apply f args
| v ->
if args = [] then v
else raise @@ Type.Invalid (Value.typeof v)
(* toplevel for global let *)
let eval_top env_ref ast =
let var, v = match ast with
| Let (var, Nfunction (arg, e)) -> (* named function *)