klisp

commit b3bca47b867fb818debfd9a87d55b052a7b4d70e
parent efdb81b5ff2206a75f0edcb82b984657d931b05f
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 25 Mar 2011 14:58:24 -0300

Added $remote-eval to the ground environment.

Diffstat:
M
src/kgenvironments.c
 | 
27
++++++++++++++++++++++++++-
M
src/kgenvironments.h
 | 
5
++++-
M
src/kground.c
 | 
2
+-

3 files changed, 31 insertions(+), 3 deletions(-)
diff --git a/src/kgenvironments.c b/src/kgenvironments.c
@@ -111,7 +111,32 @@ void make_kernel_standard_environment(klisp_State *K, TValue *xparams,
 /* TODO */
 
 /* 6.7.9 $remote-eval */
-/* TODO */
+void Sremote_eval(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_2p(K, "$remote-eval", ptree, obj, env_exp);
+
+    TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL,
+					 do_remote_eval, 1, obj);
+    kset_cc(K, new_cont);
+
+    ktail_eval(K, env_exp, denv);
+}
+
+/* Helper for $remote-eval */
+void do_remote_eval(klisp_State *K, TValue *xparams, TValue obj)
+{
+    if (!ttisenvironment(obj)) {
+	klispE_throw(K, "$remote-eval: bad type from second operand "
+		     "evaluation (expected environment)");
+	return;
+    } else {
+	TValue eval_exp = xparams[0];
+	ktail_eval(K, eval_exp, obj);
+    }
+}
 
 /* 6.7.10 $bindings->environment */
 /* TODO */
diff --git a/src/kgenvironments.h b/src/kgenvironments.h
@@ -62,7 +62,10 @@ void make_kernel_standard_environment(klisp_State *K, TValue *xparams,
 /* TODO */
 
 /* 6.7.9 $remote-eval */
-/* TODO */
+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);
 
 /* 6.7.10 $bindings->environment */
 /* TODO */
diff --git a/src/kground.c b/src/kground.c
@@ -468,7 +468,7 @@ void kinit_ground_env(klisp_State *K)
     /* TODO */
 
     /* 6.7.9 $remote-eval */
-    /* TODO */
+    add_operative(K, ground_env, "$remote-eval", Sremote_eval, 0);
 
     /* 6.7.10 $bindings->environment */
     /* TODO */