klisp

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

commit bb68806dbb11377290da23374a20b8c03b809fc0
parent b3bca47b867fb818debfd9a87d55b052a7b4d70e
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 25 Mar 2011 15:21:54 -0300

Added $set! to the ground environment.

Diffstat:
Msrc/kgenv_mut.c | 47+++++++++++++++++++++++++++++++++++++++++++++++
Msrc/kgenv_mut.h | 12++++++++++++
Msrc/kground.c | 2+-
3 files changed, 60 insertions(+), 1 deletion(-)

diff --git a/src/kgenv_mut.c b/src/kgenv_mut.c @@ -55,3 +55,50 @@ void do_match(klisp_State *K, TValue *xparams, TValue obj) match(K, name, env, ptree, obj); kapply_cc(K, KINERT); } + +/* 6.8.1 $set! */ +void SsetB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) +{ + UNUSED(denv); + + TValue sname = xparams[0]; + + bind_3p(K, "$set!", ptree, env_exp, raw_formals, eval_exp); + + TValue formals = check_copy_ptree(K, "$set!", raw_formals, KIGNORE); + + TValue new_cont = + kmake_continuation(K, kget_cc(K), KNIL, KNIL, do_set_eval_obj, 4, + sname, formals, eval_exp, denv); + kset_cc(K, new_cont); + ktail_eval(K, env_exp, denv); +} + +/* Helpers for $set! */ +void do_set_eval_obj(klisp_State *K, TValue *xparams, TValue obj) +{ + TValue sname = xparams[0]; + TValue formals = xparams[1]; + TValue eval_exp = xparams[2]; + TValue denv = xparams[3]; + + if (!ttisenvironment(obj)) { + klispE_throw_extra(K, ksymbol_buf(sname), ": bad type from first " + "operand evaluation (expected environment)"); + return; + } else { + TValue env = obj; + + TValue new_cont = + kmake_continuation(K, kget_cc(K), KNIL, KNIL, do_match, 3, + formals, env, sname); + kset_cc(K, new_cont); + ktail_eval(K, eval_exp, denv); + } +} + +/* 6.8.2 $provide! */ +/* TODO */ + +/* 6.8.3 $import! */ +/* TODO */ diff --git a/src/kgenv_mut.h b/src/kgenv_mut.h @@ -232,4 +232,16 @@ inline TValue check_copy_ptree(klisp_State *K, char *name, TValue ptree, return copy; } +/* 6.8.1 $set! */ +void SsetB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); + +/* Helper for $set! */ +void do_set_eval_obj(klisp_State *K, TValue *xparams, TValue obj); + +/* 6.8.2 $provide! */ +/* TODO */ + +/* 6.8.3 $import! */ +/* TODO */ + #endif diff --git a/src/kground.c b/src/kground.c @@ -478,7 +478,7 @@ void kinit_ground_env(klisp_State *K) */ /* 6.8.1 $set! */ - /* TODO */ + add_operative(K, ground_env, "$set!", SsetB, 1, symbol); /* 6.8.2 $provide! */ /* TODO */