diff --git a/eval.ml b/eval.ml index 74ede96..50694c4 100644 --- a/eval.ml +++ b/eval.ml @@ -259,8 +259,8 @@ let binop op l r = exception Unbound of string -let rec eval env ast = - let aux = eval env in (* eval with current env *) +let rec eval global env ast = + let aux = eval global env in (* eval with current env *) match ast with | Nothing -> Nop | Nint n -> Int n @@ -272,12 +272,13 @@ let rec eval env ast = | Nexternal f -> External f | Var v -> begin match Env.get_opt env v with - | None -> raise @@ Unbound v + | None -> (try Hashtbl.find global v + with Not_found -> raise @@ Unbound v) | Some v -> v end | Letin (v, e, f) -> let env = Env.bind (v, aux e) env in - eval env f + eval global env f | Unary (op, v) -> unary op (aux v) | Binop (l, op, r) -> binop op (aux l) (aux r) @@ -288,41 +289,41 @@ let rec eval env ast = | Bool false -> aux el | v -> raise @@ Type.Invalid (Value.typeof v) end - | Apply (v, args) -> apply v args env + | Apply (v, args) -> apply global env v args | _ -> failwith "Eval.eval" (* apply args to result of expr *) -and apply expr args env = - match eval env expr with - | Function (itself, var, e, env) as f -> +and apply global env expr args = + match eval global env expr with + | Function (itself, var, body, local_env) as f -> begin match args with | [] -> f | a::args -> - let value = eval env a in + let value = eval global env a in let env = (* binding itself into env for recursion *) itself |> Option.fold - ~none: env - ~some: (fun n -> Env.bind (n, f) env) + ~none: local_env + ~some: (fun n -> Env.bind (n, f) local_env) |> Env.bind (var, value) in - eval env @@ Apply (e, args) + apply global env body args end | External f -> - let args = List.map (eval env) args in + let args = List.map (eval global 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 global ast = let var, v = match ast with | Let (var, Nfunction (arg, e)) -> (* named function *) - var, Function (Some var, arg, e, !env_ref) - | Let (var, e) -> var, eval !env_ref e - | ast -> "-", eval !env_ref ast + var, Function (Some var, arg, e, Env.empty) + | Let (var, e) -> var, eval global Env.empty e + | ast -> "-", eval global Env.empty ast in - if var <> "-" then env_ref := Env.bind (var, v) !env_ref; + if var <> "-" then Hashtbl.replace global var v; var, v diff --git a/main.ml b/main.ml index f3dd1ba..d3ae95d 100644 --- a/main.ml +++ b/main.ml @@ -35,37 +35,38 @@ let stdlib = [ (* global environment *) let g = - ref @@ Env.bind_seq stdlib Env.empty + let g = Hashtbl.create 100 in + Hashtbl.add_seq g stdlib; + g (* read-eval-print *) -let rep env : unit = +let rep () : unit = printf "> "; let line = read_line () in if line = "quit" then raise Exit; let ast = line |> Lex.tokenize |> Parser.parse in if !debug then Ast.print ast; - let var, v = Eval.eval_top env ast in + let var, v = Eval.eval_top g ast in match v with | Nop -> () | _ -> - g := Env.bind ("ans", v) !g; + Hashtbl.replace g "ans" v; printf "%s: %s = %s\n" var (Type.to_string @@ Value.typeof v) (Value.to_string v) exception Reset_line (* used to indicate ^C is pressed *) let init_repl () = - g := Env.bind ("ans", Int 0) !g; (* treat Ctrl-C as to reset line *) let reset_line _ = raise Reset_line in Sys.(set_signal sigint (Signal_handle reset_line)) (* simple REPL with error handling *) -let rec repl env : unit = - try rep env; repl env with +let rec repl () : unit = + try rep (); repl () with | Exit | End_of_file (* Ctrl-D *) -> () - | Reset_line -> printf "\n"; repl env - | e -> print_error e; repl env + | Reset_line -> printf "\n"; repl () + | e -> print_error e; repl () let speclist = [ "--debug", Arg.Set debug, "print debug infos"; @@ -75,4 +76,4 @@ let () = Arg.parse speclist (fun _ -> ()) ""; init_repl (); printf "Configurable Evaluator %s\n" version; (* banner *) - repl g + repl ()