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