klisp

commit e0678d72256220d66159a2f43665af510db85d79
parent 145c7b439648b359c021a316a02144d5f6e74d8f
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Sat,  5 Mar 2011 16:37:01 -0300

Basic structure of a primitive REPL (added eval step, for now it is an identity fn).

Diffstat:
M
src/klisp.c
 | 
93
+++++++++++++++++++++++++++++++++++++++++++++++++------------------------------

1 file changed, 58 insertions(+), 35 deletions(-)
diff --git a/src/klisp.c b/src/klisp.c
@@ -25,20 +25,6 @@
 #include "kenvironment.h"
 #include "koperative.h"
 
-/*
-** Simple read/write loop
-*/
-void main_body(klisp_State *K)
-{
-    TValue obj = KNIL;
-
-    while(!ttiseof(obj)) {
-	obj = kread(K);
-	kwrite(K, obj);
-	knewline(K);
-    }
-}
-
 /* the exit continuation, it exits the loop */
 void exit_fn(klisp_State *K, TValue *xparams, TValue obj)
 {
@@ -51,33 +37,62 @@ void exit_fn(klisp_State *K, TValue *xparams, TValue obj)
     return;
 }
 
-/* the underlying function of the read operative */
-void read_fn(klisp_State *K, TValue *xparams, TValue ptree, TValue env)
+/* the underlying function of the eval cont */
+void eval_ofn(klisp_State *K, TValue *xparams, TValue obj, TValue env)
 {
-    (void) ptree;
-    (void) env;
     (void) xparams;
-    TValue obj = kread(K);
-    kapply_cc(K, obj);
+    (void) env;
+
+    switch(ttype(obj)) {
+    case K_TPAIR:
+	/* TODO */
+	kapply_cc(K, obj);
+	break;
+    case K_TSYMBOL:
+	/* TODO */
+	kapply_cc(K, obj);
+	break;
+    default:
+	kapply_cc(K, obj);
+    }
+}
+
+/* the underlying function of the eval operative */
+void eval_cfn(klisp_State *K, TValue *xparams, TValue obj)
+{
+    /* 
+    ** tparams[0]: eval operative
+    ** tparams[1]: dynamic environment
+    */
+    TValue eval_op = xparams[0];
+    TValue denv = xparams[1];
+    
+    ktail_call(K, eval_op, obj, denv);
 }
 
-/* the underlying function of the loop */
+/* the underlying function of the write & loop  cont */
 void loop_fn(klisp_State *K, TValue *xparams, TValue obj)
 {
-    /* tparams[0] is the read operative,
-     in tparams[1] a dummy environment */
+    /* 
+    ** tparams[0]: eval operative
+    ** tparams[1]: dynamic environment
+    */
     if (ttiseof(obj)) {
 	/* this will in turn call main_cont */
 	kapply_cc(K, obj);
     } else {
 	kwrite(K, obj);
 	knewline(K);
-	TValue read_op = *xparams;
-	TValue dummy_env = *xparams;
-	TValue new_cont = kmake_continuation(
-	    K, kget_cc(K), KNIL, KNIL, &loop_fn, 2, read_op, dummy_env);
-	kset_cc(K, new_cont);
-	ktail_call(K, read_op, KNIL, dummy_env);
+	TValue eval_op = xparams[0];
+	TValue denv = xparams[1];
+
+	TValue loop_cont = kmake_continuation(
+	    K, kget_cc(K), KNIL, KNIL, &loop_fn, 2, eval_op, denv);
+	TValue eval_cont = kmake_continuation(
+	    K, loop_cont, KNIL, KNIL, &eval_cfn, 2, eval_op, denv);
+	kset_cc(K, eval_cont);
+	TValue robj = kread(K);
+	kapply_cc(K, robj);
     }
 } 
 
@@ -88,15 +103,19 @@ int main(int argc, char *argv[])
     klisp_State *K = klispL_newstate();
 
     /* set up the continuations */
-    TValue read_op = kmake_operative(K, KNIL, KNIL, read_fn, 0);
-    TValue dummy_env = kmake_empty_environment(K);
+    TValue eval_op = kmake_operative(K, KNIL, KNIL, eval_ofn, 0);
+    TValue ground_env = kmake_empty_environment(K);
+    TValue std_env = kmake_environment(K, ground_env);
     TValue root_cont = kmake_continuation(K, KNIL, KNIL, KNIL,
 					  exit_fn, 0);
-    TValue loop_cont = kmake_continuation(K, root_cont, KNIL, KNIL,
-					  loop_fn, 2, read_op, dummy_env);
-    kset_cc(K, loop_cont);
+    TValue loop_cont = kmake_continuation(
+	K, root_cont, KNIL, KNIL, &loop_fn, 2, eval_op, std_env);
+    TValue eval_cont = kmake_continuation(
+	K, loop_cont, KNIL, KNIL, &eval_cfn, 2, eval_op, std_env);
+    
+    kset_cc(K, eval_cont);
     /* NOTE: this will take effect only in the while (K->next_func) loop */
-    klispS_tail_call(K, read_op, KNIL, dummy_env);
+    klispS_apply_cc(K, kread(K));
 
     int ret_value = 0;
     bool done = false;
@@ -110,6 +129,10 @@ int main(int argc, char *argv[])
 		ks_sclear(K);
 		ks_tbclear(K);
 		K->shared_dict = KNIL;
+		
+		kset_cc(K, eval_cont);
+		/* NOTE: this will take effect only in the while (K->next_func) loop */
+		klispS_apply_cc(K, kread(K));
 	    } else {
 		printf("Aborting...\n");
 		ret_value = 1;