Re-organized a lot of code, changed functions so that functions capture the surrounding environment and execute in that environment

lib/eval.ml

@@ -5,7 +5,7 @@ open InterpreterStdlib;;
 let default_env: environment = [Hashtbl.create 1024];;
 
 let add_builtin s f =
-  env_add default_env s (LBuiltinFunction (s, f))
+  env_set_global default_env s (LBuiltinFunction (s, f))
 let () = add_builtin "+" iadd
 let () = add_builtin "-" isub
 let () = add_builtin "car" car
@@ -24,18 +24,11 @@ let rec eval_sym (env: environment) (s: string) =
     | None -> eval_sym rest s
     | Some v -> v
 
-let rec eval_one env v = 
-  match v with
-  | LInt x -> LInt x
-  | LDouble x -> LDouble x
-  | LString s -> LString s
+let rec eval_one env = function
   | LSymbol s -> eval_sym env s
-  | LNil -> LNil
-  | LCons (func, args) -> eval_call env func args
-  | LBuiltinFunction (n, f) -> LBuiltinFunction (n, f)
-  | LFunction (n, l, f) -> LFunction (n, l, f)
-  | LMacro (n, l, f) -> LMacro (n, l, f)
+  | LCons (func, args) -> eval_call env (eval_one env func) args
   | LQuoted v -> v
+  | v -> v (* All other forms are self-evaluating *)
 
 (* Evaluate a list of values, without evaluating the resulting
 function or macro call. Since macros and functions inherently
@@ -50,44 +43,44 @@ and eval_body env body =
   match body with
   | LNil -> LNil
   | LCons (form, LNil) -> eval_one env form
-  | LCons (form, next) -> 
-    ignore (eval_one env form); eval_body env next
+  | LCons (form, next) -> ignore (eval_one env form); eval_body env next
   | _ -> LNil
 
-and eval_apply env func args =
-  let lexical_env = env_new_lexical env in
-  let rec bind_one s a =
-    match a with
-    | LNil -> raise (Invalid_argument "not enough arguments supplied to function")
-    | LCons (value, resta) ->
-      env_add lexical_env s value; resta
-    | _ -> raise (Invalid_argument "invalid argument list")
-  and bind_args l a =
-    match l with
-    | LNil -> (match a with
-      | LNil -> ()
-      | _ -> raise (Invalid_argument "too many arguments supplied to function"))
-    | LCons (LSymbol sym, LSymbol restl)->
-      env_add lexical_env restl (bind_one sym a)
-    | LCons (LSymbol sym, restl) ->
-      bind_args restl (bind_one sym a)
-    | _ -> raise (Invalid_argument "Failure while binding arguments")
-  in match func with
-  | LFunction (_, l, b) ->
-    bind_args l args;
+and err s = raise (Invalid_argument s)
+and bind_args env = function
+  | LNil -> (function
+      | LNil -> () | _ -> err "bind_args")
+  | LCons (LSymbol hl, tl) -> (function
+      | LCons (ha, ta) -> 
+        env_set_local env hl ha;
+        bind_args env tl ta;
+      | _ -> err "bind_args")
+  | _ -> fun _ -> err "bind_args"
+  
+and eval_apply args = function
+  | LFunction (_, e, l, b) ->
+    let lexical_env = env_new_lexical e in
+    bind_args lexical_env l args;
     eval_body lexical_env b
-  | LMacro (_, l, b) ->
-    bind_args l args;
+  | LMacro (_, e, l, b) ->
+    let lexical_env = env_new_lexical e in
+    bind_args lexical_env l args;
     eval_body lexical_env b
-  | _ -> LNil
+  | v ->
+    err ("Non-macro non-function value passed to eval_apply "
+        ^ dbg_print_one v); LNil
     
 
 
 and eval_call env func args =
-  match eval_one env func with
+  match func with
   | LBuiltinFunction (_, f) -> f env (eval_list env args)
-  | LFunction (n, l, b) -> eval_apply env (LFunction (n, l, b)) (eval_list env args)
-  | LMacro (n, l, b) -> eval_apply env (LMacro (n, l, b)) args
+  (* The function calls don't happen in the calling environment,
+  so it makes no sense to pass env to a call. *)
+  | LFunction _ -> eval_apply (eval_list env args) func
+  (* Macros are the same, they just return code that *will* be evaluated
+  in the calling environment *)
+  | LMacro _ -> eval_apply args func
   | v -> raise (Invalid_argument 
         (Printf.sprintf "eval_apply: cannot call non-function object %s" (dbg_print_one v)));;