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