commit 141c1a0e25050e10862828398ad57caa3ccf4fc2
parent 1f3aab1d158d6149314883a315a38bc2380ebf6f
Author: Andres Navarro <canavarro82@gmail.com>
Date: Mon, 28 Mar 2011 15:25:48 -0300
Added $let to the ground environment.
Diffstat:
4 files changed, 65 insertions(+), 9 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -102,7 +102,7 @@ kgpair_mut.o: kgpair_mut.c kgpair_mut.h kghelpers.h kstate.h klisp.h \
kobject.h kerror.h kpair.h ksymbol.h kcontinuation.h kgeqp.h
kgenvironments.o: kgenvironments.c kgenvironments.h kghelpers.h kstate.h \
klisp.h kobject.h kerror.h kpair.h ksymbol.h kcontinuation.h \
- kenvironment.h kgenv_mut.h kgpair_mut.h
+ kenvironment.h kgenv_mut.h kgpair_mut.h kgcontrol.h
kgenv_mut.o: kgenv_mut.c kgenv_mut.h kghelpers.h kstate.h \
klisp.h kobject.h kerror.h kpair.h ksymbol.h kcontinuation.h \
kenvironment.h
diff --git a/src/kgenvironments.c b/src/kgenvironments.c
@@ -22,6 +22,7 @@
#include "kgenvironments.h"
#include "kgenv_mut.h" /* for check_ptree */
#include "kgpair_mut.h" /* for copy_es_immutable_h */
+#include "kgcontrol.h" /* for do_seq */
/* MAYBE: move the above to kghelpers.h */
/* 4.8.1 environment? */
@@ -145,27 +146,77 @@ TValue split_check_let_bindings(klisp_State *K, char *name, TValue bindings,
}
}
+/*
+** Continuation function for all the let family
+** it expects the result of the last evaluation to be matched to
+** this-ptree
+*/
+void do_let(klisp_State *K, TValue *xparams, TValue obj)
+{
+ /*
+ ** xparams[0]: symbol name
+ ** xparams[1]: this ptree
+ ** xparams[2]: remaining bindings
+ ** xparams[3]: remaining exprs
+ ** xparams[4]: match environment
+ ** xparams[5]: rec/not rec flag
+ ** xparams[6]: body
+ */
+ TValue sname = xparams[0];
+ char *name = ksymbol_buf(sname);
+ TValue ptree = xparams[1];
+ TValue bindings = xparams[2];
+ TValue exprs = xparams[3];
+ TValue env = xparams[4];
+ bool recp = bvalue(xparams[5]);
+ TValue body = xparams[6];
+
+ /* XXX */
+ UNUSED(recp);
+ UNUSED(bindings);
+ UNUSED(exprs);
+
+ match(K, name, env, ptree, obj);
+
+ /* TODO: check bindings */
+ if (ttisnil(body)) {
+ kapply_cc(K, KINERT);
+ } else {
+ /* this is needed because seq continuation doesn't check for
+ nil sequence */
+ TValue tail = kcdr(body);
+ if (ttispair(tail)) {
+ TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL,
+ do_seq, 2, tail, env);
+ kset_cc(K, new_cont);
+ }
+ ktail_eval(K, kcar(body), env);
+ }
+}
+
/* 5.10.1 $let */
-/* TEMP: for now this only checks the parameters and makes copies */
-/* XXX: it doesn't do any evaluation or env creation */
+/* REFACTOR: reuse code in other members of the $let family */
void Slet(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
{
/*
** xparams[0]: symbol name
*/
- UNUSED(denv);
- char *name = ksymbol_buf(xparams[0]);
+ TValue sname = xparams[0];
+ char *name = ksymbol_buf(sname);
bind_al1p(K, name, ptree, bindings, body);
TValue exprs;
- TValue btree = split_check_let_bindings(K, name, bindings, &exprs, false);
+ TValue bptree = split_check_let_bindings(K, name, bindings, &exprs, false);
int32_t dummy;
UNUSED(check_list(K, name, true, body, &dummy));
body = copy_es_immutable_h(K, name, body, false);
- /* XXX */
- TValue res = kcons(K, btree, kcons(K, exprs, body));
- kapply_cc(K, res);
+ TValue new_env = kmake_environment(K, denv);
+ TValue new_cont =
+ kmake_continuation(K, kget_cc(K), KNIL, KNIL, do_let, 7, sname,
+ bptree, KNIL, KNIL, new_env, b2tv(false), body);
+ kset_cc(K, new_cont);
+ ktail_eval(K, kcons(K, K->list_app, exprs), denv);
}
/* 6.7.1 $binds? */
diff --git a/src/kstate.c b/src/kstate.c
@@ -33,6 +33,8 @@
#include "kstring.h"
#include "kport.h"
+#include "kgpairs_lists.h" /* for creating list_app */
+
/*
** State creation and destruction
*/
@@ -65,6 +67,7 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/* these will be properly initialized later */
K->eval_op = KINERT;
+ K->list_app = KINERT;
K->ground_env = KINERT;
K->module_params_sym = KINERT;
K->root_cont = KINERT;
@@ -138,6 +141,7 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
/* create the ground environment and the eval operative */
K->eval_op = kmake_operative(K, KNIL, KNIL, keval_ofn, 0);
+ K->list_app = kwrap(K, kmake_operative(K, KNIL, KNIL, list, 0));
K->ground_env = kmake_empty_environment(K);
K->module_params_sym = ksymbol_new(K, "module-parameters");
diff --git a/src/kstate.h b/src/kstate.h
@@ -52,6 +52,7 @@ struct klisp_State {
TValue *next_xparams;
TValue eval_op; /* the operative for evaluation */
+ TValue list_app; /* the applicative for list evaluation */
TValue ground_env; /* the environment with all the ground definitions */
/* standard environments are environments with no bindings and ground_env
as parent */
