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!
This commit is contained in:
		@@ -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>"
 | 
			
		||||
 
 | 
			
		||||
							
								
								
									
										10
									
								
								lib/eval.ml
									
									
									
									
									
								
							
							
						
						
									
										10
									
								
								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 *)
 | 
			
		||||
 
 | 
			
		||||
@@ -50,11 +50,23 @@ 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!")
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user