klisp

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:
M
src/kgenvironments.c
 | 
31
+++++++++++++++++++++++++++----
M
src/kgenvironments.h
 | 
6
+++++-
M
src/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