diff --git a/lib/ast.ml b/lib/ast.ml index 8c4cfaf..aa48e11 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -11,8 +11,10 @@ type lisp_val = generally, builtin functions should handle their arguments directly, and eval forms in the environment as necessary. *) | LBuiltinFunction of string * (environment -> lisp_val -> lisp_val) + | LBuiltinSpecial of string * (environment -> lisp_val -> lisp_val) (* a function is a name, captured environment, a parameter list, and function body. *) | LFunction of string * environment * lisp_val * lisp_val + | LLambda of environment * lisp_val * lisp_val (* a macro is exactly the same as a function, with the distinction that it receives all of its arguments completely unevaluated in a compiled lisp this would probably make more of a difference *) @@ -51,7 +53,10 @@ let rec dbg_print_one v = | LNil -> pf "()" | LCons (a, b) -> pf "(%s . %s)" (dbg_print_one a) (dbg_print_one b) | LDouble d -> pf "" d + | LBuiltinSpecial (name, _) | LBuiltinFunction (name, _) -> pf "" name + | LLambda (_, args, _) -> pf "" + (dbg_print_one args) | LFunction (name, _, args, _) -> pf "" name (dbg_print_one args) | LMacro (name, _, args, _) -> pf "" diff --git a/lib/eval.ml b/lib/eval.ml index 5478fd3..f246e01 100644 --- a/lib/eval.ml +++ b/lib/eval.ml @@ -6,11 +6,14 @@ let default_env: environment = [Hashtbl.create 1024];; let add_builtin 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)) let () = add_builtin "+" iadd let () = add_builtin "-" isub let () = add_builtin "car" car let () = add_builtin "cdr" cdr -let () = add_builtin "bind-function" bind_function +let () = add_builtin "bind-symbol" bind_symbol +let () = add_special "lambda" lambda let make_env () = [Hashtbl.copy (List.hd default_env)] @@ -58,6 +61,7 @@ and bind_args env = function | _ -> fun _ -> err "bind_args" and eval_apply args = function + | LLambda (e, l, b) | LFunction (_, e, l, b) -> let lexical_env = env_new_lexical e in bind_args lexical_env l args; @@ -74,9 +78,11 @@ and eval_apply args = function and eval_call env func args = match func with + | LBuiltinSpecial (_, f) -> f env args | LBuiltinFunction (_, f) -> f env (eval_list env args) (* The function calls don't happen in the calling environment, - so it makes no sense to pass env to a call. *) + so it makes no sense to pass env to a call. *) + | LLambda _ | LFunction _ -> eval_apply (eval_list env args) func (* Macros are the same, they just return code that *will* be evaluated in the calling environment *) diff --git a/lib/interpreterStdlib.ml b/lib/interpreterStdlib.ml index cf89bed..c998cd0 100644 --- a/lib/interpreterStdlib.ml +++ b/lib/interpreterStdlib.ml @@ -1,6 +1,6 @@ open Ast;; -let iadd _ vs : lisp_val = +let iadd _ vs : lisp_val = let rec auxi vs accum = match vs with | LCons (LInt a, b) -> (auxi b (accum + a)) @@ -12,7 +12,7 @@ let iadd _ vs : lisp_val = | LCons (LDouble a, b) -> (auxf b (accum +. a)) | _ -> LDouble accum in (auxi vs 0);; -let isub _ vs = +let isub _ vs = let rec auxi vs accum = match vs with | LNil -> LInt accum @@ -46,15 +46,27 @@ let cdr _ vs = (* This is the special built-in function that allows us to create -a new function. +a new function. (bind-function 'sym '(a b) '(+ a b)) *) -let bind_function env vs = - let rais () = raise (Invalid_argument "not enough args to bind-function") in - match vs with - | LCons (LSymbol sym, LCons (ll, body)) -> - let f = (LFunction (sym, env_copy env, ll, body)) in - env_set_global env sym f; + +(* Binds any value to a symbol, in the *global environment*. *) +let bind_symbol env = + function + (* Special case for setting a function to a symbol, if the function + is a lambda then we turn it into a real "function" by giving it this + new name *) + | LCons (LSymbol s, LCons (LLambda (e, l, b), LNil)) -> + let f = LFunction (s, e, l, b) in + env_set_global env s f; f - | _ -> rais () + | LCons (LSymbol s, LCons (v, LNil)) -> + env_set_global env s v; + v + | _ -> raise (Invalid_argument "invalid args to set!") + +let lambda env = function + | LCons (l, body) -> + LLambda (env, l, body) + | _ -> raise (Invalid_argument "invalid args to lambda!")