Added builtin special forms, lambda forms and bind-symbol. got rid of bind-function, as it is now unnecessary. it is now possible to create functions!

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 "<double: %f>" d
+  | LBuiltinSpecial (name, _)
   | LBuiltinFunction (name, _) -> pf "<builtin: %s>" name
+  | LLambda (_, args, _) -> pf "<unnamed function, lambda-list: %s>"
+    (dbg_print_one args)
   | LFunction (name, _, args, _) -> pf "<function: '%s' lambda-list: %s>" 
     name (dbg_print_one args)
   | LMacro (name, _, args, _) -> pf "<function '%s' lambda-list: %s>"

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

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!")