Split global and local environment

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

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 ()