klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

commit 15d5873d8647282b5137b001f7bf4cbc7e3f8637
parent 245ffa2c3de091f1dd89084dbaec21695ad03bdc
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Tue, 29 Mar 2011 17:37:02 -0300

Added $bindings->environment to the ground environment.

Diffstat:
Msrc/kgenvironments.c | 31+++++++++++++++++++++++++++----
Msrc/kgenvironments.h | 6+++++-
Msrc/kground.c | 3++-
3 files changed, 34 insertions(+), 6 deletions(-)

diff --git a/src/kgenvironments.c b/src/kgenvironments.c @@ -171,9 +171,6 @@ void do_let(klisp_State *K, TValue *xparams, TValue obj) bool recp = bvalue(xparams[5]); TValue body = xparams[6]; - /* XXX */ - UNUSED(recp); - match(K, name, env, ptree, obj); if (ttisnil(bindings)) { @@ -449,5 +446,31 @@ void do_remote_eval(klisp_State *K, TValue *xparams, TValue obj) } } +/* Helper for $bindings->environment */ +void do_b_to_env(klisp_State *K, TValue *xparams, TValue obj) +{ + /* + ** xparams[0]: ptree + ** xparams[1]: created env + */ + TValue ptree = xparams[0]; + TValue env = xparams[1]; + + match(K, "$bindings->environment", env, ptree, obj); + kapply_cc(K, env); +} + /* 6.7.10 $bindings->environment */ -/* TODO */ +void Sbindings_to_environment(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv) +{ + UNUSED(xparams); + TValue exprs; + TValue bptree = split_check_let_bindings(K, "$bindings->environment", + ptree, &exprs, false); + TValue new_env = kmake_environment(K, KNIL); + TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL, + do_b_to_env, 2, bptree, new_env); + kset_cc(K, new_cont); + ktail_eval(K, kcons(K, K->list_app, exprs), denv); +} diff --git a/src/kgenvironments.h b/src/kgenvironments.h @@ -73,7 +73,11 @@ void Sremote_eval(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); /* Helper for $remote-eval */ void do_remote_eval(klisp_State *K, TValue *xparams, TValue obj); +/* Helper for $bindings->environment */ +void do_b_to_env(klisp_State *K, TValue *xparams, TValue obj); + /* 6.7.10 $bindings->environment */ -/* TODO */ +void Sbindings_to_environment(klisp_State *K, TValue *xparams, TValue ptree, + TValue denv); #endif diff --git a/src/kground.c b/src/kground.c @@ -470,7 +470,8 @@ void kinit_ground_env(klisp_State *K) add_operative(K, ground_env, "$remote-eval", Sremote_eval, 0); /* 6.7.10 $bindings->environment */ - /* TODO */ + add_operative(K, ground_env, "$bindings->environment", + Sbindings_to_environment, 1, symbol); /* ** 6.8 Environment mutation