klisp

commit 5369e731308efb9a406db870442e6c7dc3d43faa
parent b50e77e2920797687ab14ac3dc7faa0082f39ff6
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sun, 13 Mar 2011 03:26:15 -0300

Added root-continuation and error-continuation to the ground environment.

Diffstat:
M
src/Makefile
 | 
2
+-
M
src/kground.c
 | 
17
++++++++++-------
M
src/kground.h
 | 
2
+-
M
src/krepl.c
 | 
9
+++++++++
M
src/kstate.c
 | 
10
++++++++--

5 files changed, 29 insertions(+), 11 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -66,7 +66,7 @@ kapplicative.o: kapplicative.c kapplicative.h kmem.h kstate.h kobject.h \
 keval.o: keval.c keval.h kcontinuation.h kenvironment.h kstate.h kobject.h \
 	kpair.h kerror.h klisp.h
 krepl.o: krepl.c krepl.h kcontinuation.h kstate.h kobject.h keval.h klisp.h \
-	kread.h kwrite.h kenvironment.h
+	kread.h kwrite.h kenvironment.h ksymbol.h
 kground.o: kground.c kground.h kstate.h kobject.h klisp.h kenvironment.h \
 	kapplicative.h koperative.h ksymbol.h kerror.h kghelpers.h \
 	kgbooleans.h kgeqp.h kgequalp.h kgsymbols.h kgpairs_lists.h \
diff --git a/src/kground.c b/src/kground.c
@@ -50,10 +50,9 @@
 /*
 ** This is called once to bind all symbols in the ground environment
 */
-TValue kmake_ground_env(klisp_State *K)
+void kinit_ground_env(klisp_State *K)
 {
-    TValue ground_env = kmake_empty_environment(K);
-
+    TValue ground_env = K->ground_env;
     TValue symbol, value;
 
     /*
@@ -366,10 +365,14 @@ TValue kmake_ground_env(klisp_State *K)
     /* TODO */
 
     /* 7.2.6 root-continuation */
-    /* TODO */
-
+    symbol = ksymbol_new(K, "root-continuation");
+    value = K->root_cont;
+    kadd_binding(K, ground_env, symbol, value);
+    
     /* 7.2.7 error-continuation */
-    /* TODO */
+    symbol = ksymbol_new(K, "error-continuation");
+    value = K->error_cont;
+    kadd_binding(K, ground_env, symbol, value);
 
     /* 
     ** 7.3 Library features
@@ -387,5 +390,5 @@ TValue kmake_ground_env(klisp_State *K)
     /* 7.3.4 exit */    
     /* TODO */
 
-    return ground_env;
+    return;
 }
diff --git a/src/kground.h b/src/kground.h
@@ -9,6 +9,6 @@
 
 #include "kstate.h"
 
-TValue kmake_ground_env(klisp_State *K);
+void kinit_ground_env(klisp_State *K);
 
 #endif
diff --git a/src/krepl.c b/src/krepl.c
@@ -16,6 +16,7 @@
 #include "kwrite.h"
 #include "kstring.h"
 #include "krepl.h"
+#include "ksymbol.h"
 
 /* the exit continuation, it exits the loop */
 void exit_fn(klisp_State *K, TValue *xparams, TValue obj)
@@ -112,6 +113,14 @@ void kinit_repl(klisp_State *K)
     TValue error_cont = kmake_continuation(K, KNIL, KNIL, KNIL,
 					   error_fn, 1, std_env);
 
+    /* update the ground environment with these two conts */
+    TValue symbol;
+    symbol = ksymbol_new(K, "root-continuation");
+    kadd_binding(K, K->ground_env, symbol, root_cont);
+    symbol = ksymbol_new(K, "error-continuation");
+    kadd_binding(K, K->ground_env, symbol, error_cont);
+
+    /* and save them in the structure */
     K->root_cont = root_cont;
     K->error_cont = error_cont;
 
diff --git a/src/kstate.c b/src/kstate.c
@@ -19,6 +19,7 @@
 #include "kmem.h"
 #include "keval.h"
 #include "koperative.h"
+#include "kenvironment.h"
 #include "kground.h"
 #include "krepl.h"
 
@@ -52,8 +53,11 @@ klisp_State *klisp_newstate (klisp_Alloc f, void *ud) {
     K->next_env = KNIL;
     K->next_xparams = NULL;
 
+    /* these will be properly initialized later */
     K->eval_op = KINERT;
     K->ground_env = KINERT;
+    K->root_cont = KINERT;
+    K->error_cont = KINERT;
 
     K->frealloc = f;
     K->ud = ud;
@@ -109,7 +113,9 @@ 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->ground_env = kmake_ground_env(K);
+    K->ground_env = kmake_empty_environment(K);
+    
+    kinit_ground_env(K);
 
     return K;
 }
@@ -130,7 +136,7 @@ void kcall_cont(klisp_State *K, TValue dst_cont, TValue obj)
 
 void klispS_init_repl(klisp_State *K)
 {
-    /* this is in repl.c */
+    /* this is in krepl.c */
     kinit_repl(K);
 }