diff --git a/lib/ast.ml b/lib/ast.ml index 7861d88..a746c02 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -21,38 +21,11 @@ type lisp_val = | LMacro of string * environment * lisp_val * lisp_val | LUnnamedMacro of environment * lisp_val * lisp_val | LQuoted of lisp_val +(* the environment type needs to be defined here, as it is mutually + recursive with lisp_val *) and environment = (string, lisp_val) Hashtbl.t list -let env_set_local env s v = - match env with - | [] -> () - | e1 :: _ -> Hashtbl.replace e1 s v - -let rec env_update env s v = - match env with - | [] -> () - | e1 :: erest -> - match Hashtbl.find_opt e1 s with - | None -> env_update erest s v - | Some _ -> Hashtbl.replace e1 s v - -let env_new_lexical env = - let h = Hashtbl.create 16 in - h :: env - -let rec env_root (env : environment) = - match env with - | [] -> raise (Invalid_argument "Empty environment passed to env_root!") - | e :: [] -> e - | _ :: t -> env_root t - -let env_set_global env s v = - Hashtbl.replace (env_root env) s v - -let env_copy env = - List.map Hashtbl.copy env - let rec dbg_print_one v = let pf = Printf.sprintf in match v with diff --git a/lib/env.ml b/lib/env.ml new file mode 100644 index 0000000..a494fab --- /dev/null +++ b/lib/env.ml @@ -0,0 +1,34 @@ +open Ast +(* the type `environment` is defined in Ast *) + + +let new_lexical env = + let h = Hashtbl.create 16 in + h :: env + +let set_local env s v = + match env with + | [] -> () + | e1 :: _ -> Hashtbl.replace e1 s v + +let rec update env s v = + match env with + | [] -> () + | e1 :: erest -> + match Hashtbl.find_opt e1 s with + | None -> update erest s v + | Some _ -> Hashtbl.replace e1 s v + +let rec get_root (env : environment) = + match env with + | [] -> raise (Invalid_argument "Empty environment passed to env_root!") + | e :: [] -> e + | _ :: t -> get_root t + +let set_global env s v = + Hashtbl.replace (get_root env) s v + +let copy env = + List.map Hashtbl.copy env + + diff --git a/lib/env.ml~ b/lib/env.ml~ new file mode 100644 index 0000000..9a40e19 --- /dev/null +++ b/lib/env.ml~ @@ -0,0 +1,28 @@ +let env_set_local env s v = + match env with + | [] -> () + | e1 :: _ -> Hashtbl.replace e1 s v + +let rec env_update env s v = + match env with + | [] -> () + | e1 :: erest -> + match Hashtbl.find_opt e1 s with + | None -> env_update erest s v + | Some _ -> Hashtbl.replace e1 s v + +let env_new_lexical env = + let h = Hashtbl.create 16 in + h :: env + +let rec env_root (env : environment) = + match env with + | [] -> raise (Invalid_argument "Empty environment passed to env_root!") + | e :: [] -> e + | _ :: t -> env_root t + +let env_set_global env s v = + Hashtbl.replace (env_root env) s v + +let env_copy env = + List.map Hashtbl.copy env diff --git a/lib/eval.ml b/lib/eval.ml index e87735c..48241ef 100644 --- a/lib/eval.ml +++ b/lib/eval.ml @@ -5,11 +5,11 @@ open InterpreterStdlib;; let default_env: environment = [Hashtbl.create 1024];; let add_builtin s f = - env_set_global default_env s (LBuiltinFunction (s, f)) + Env.set_global default_env s (LBuiltinFunction (s, f)) let add_special s f = - env_set_global default_env s (LBuiltinSpecial (s, f)) + Env.set_global default_env s (LBuiltinSpecial (s, f)) -let make_env () = [Hashtbl.copy (List.hd default_env)] +let make_env () = Env.copy default_env (* the type annotations are unnecessary, but help constrain us from a potentially more general function here *) @@ -50,10 +50,10 @@ and bind_args env = function | _ -> err "cannot bind arguments") | LSymbol s -> (function - | v -> env_set_local env s v; ()) + | v -> Env.set_local env s v; ()) | LCons (LSymbol hl, tl) -> (function | LCons (ha, ta) -> - env_set_local env hl ha; + Env.set_local env hl ha; bind_args env tl ta; | _ -> err "cannot bind arguments") | _ -> fun _ -> err "bind_args" @@ -61,12 +61,12 @@ and bind_args env = function and eval_apply args = function | LLambda (e, l, b) | LFunction (_, e, l, b) -> - let lexical_env = env_new_lexical e in + let lexical_env = Env.new_lexical e in bind_args lexical_env l args; eval_body lexical_env b | LUnnamedMacro (e, l, b) | LMacro (_, e, l, b) -> - let lexical_env = env_new_lexical e in + let lexical_env = Env.new_lexical e in bind_args lexical_env l args; eval_body lexical_env b | v -> @@ -93,8 +93,8 @@ and eval_call env func args = and (* This only creates a *local* binding, contained to the body given. *) bind_local env = function | LCons (LSymbol s, LCons (v, body)) -> - let e = env_new_lexical env in - env_set_local e s v; + let e = Env.new_lexical env in + Env.set_local e s v; eval_body e body | _ -> invalid_arg "invalid argument to bind-local" @@ -102,7 +102,7 @@ and (* This only creates a *local* binding, contained to the body given. *) and lisp_define env = function | LCons (LSymbol s, LCons (v, LNil)) -> let evaluated = eval_one env v in - env_set_global env s evaluated; + Env.set_global env s evaluated; evaluated | _ -> invalid_arg "invalid args to def" diff --git a/lib/interpreterStdlib.ml b/lib/interpreterStdlib.ml index 59941ed..d4fc2b4 100644 --- a/lib/interpreterStdlib.ml +++ b/lib/interpreterStdlib.ml @@ -50,7 +50,7 @@ let lisp_list _ vs = vs (* builtin function that updates an existing binding *) let lisp_set env = function | LCons (LSymbol s, LCons (v, LNil)) -> - env_update env s v; + Env.update env s v; v | _ -> invalid_arg "invalid args to set"