Seperate apply from eval
This commit is contained in:
parent
71bc70d3bc
commit
34eeff4a01
1 changed files with 29 additions and 28 deletions
57
eval.ml
57
eval.ml
|
@ -219,9 +219,9 @@ let binop op l r =
|
||||||
|
|
||||||
exception Unbound of string
|
exception Unbound of string
|
||||||
|
|
||||||
(* TODO: refactor eval, split function into parts *)
|
|
||||||
let rec eval env ast =
|
let rec eval env ast =
|
||||||
let rec aux = function
|
let aux = eval env in (* eval with current env *)
|
||||||
|
match ast with
|
||||||
| Nothing -> Nop
|
| Nothing -> Nop
|
||||||
| Nint n -> Int n
|
| Nint n -> Int n
|
||||||
| Nfloat n -> Float n
|
| Nfloat n -> Float n
|
||||||
|
@ -241,36 +241,14 @@ let rec eval env ast =
|
||||||
|
|
||||||
| Unary (op, v) -> unary op (aux v)
|
| Unary (op, v) -> unary op (aux v)
|
||||||
| Binop (l, op, r) -> binop op (aux l) (aux r)
|
| Binop (l, op, r) -> binop op (aux l) (aux r)
|
||||||
|
|
||||||
| If (co, th, el) ->
|
| If (co, th, el) ->
|
||||||
begin match aux co with
|
begin match aux co with
|
||||||
| Bool true -> aux th
|
| Bool true -> aux th
|
||||||
| Bool false -> aux el
|
| Bool false -> aux el
|
||||||
| v -> raise @@ Type.Invalid (Value.typeof v)
|
| v -> raise @@ Type.Invalid (Value.typeof v)
|
||||||
end
|
end
|
||||||
|
| Apply (v, args) -> apply v args env
|
||||||
| 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
|
|
||||||
|
|
||||||
| Set_binop_pre (op, l) ->
|
| Set_binop_pre (op, l) ->
|
||||||
let l =
|
let l =
|
||||||
|
@ -290,9 +268,32 @@ let rec eval env ast =
|
||||||
| None -> String "left"
|
| None -> String "left"
|
||||||
| Some a -> String (Parser.assoc_to_string a))
|
| Some a -> String (Parser.assoc_to_string a))
|
||||||
| _ -> failwith "Eval.eval"
|
| _ -> 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 eval_top env_ref ast =
|
||||||
let var, v = match ast with
|
let var, v = match ast with
|
||||||
| Let (var, Nfunction (arg, e)) -> (* named function *)
|
| Let (var, Nfunction (arg, e)) -> (* named function *)
|
||||||
|
|
Loading…
Add table
Reference in a new issue