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:
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 */