klisp

commit 17e44f66eaef4a437d563bc8fda434dae63c41d2
parent 0ee171b358bf4a71b87bd085aab2ff672e944888
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Tue, 15 Mar 2011 18:07:36 -0300

Bugfix: The interceptors should be passed an applicative representing the outer continuation in addition to the passed obj.

Diffstat:
M
src/Makefile
 | 
2
+-
M
src/kgcontinuations.c
 | 
15
+--------------
M
src/kstate.c
 | 
23
++++++++++++++++++-----
M
src/kstate.h
 | 
2
++

4 files changed, 22 insertions(+), 20 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -51,7 +51,7 @@ kwrite.o: kwrite.c kwrite.h kobject.h kpair.h kstring.h kstate.h kerror.h \
 	klisp.h
 kstate.o: kstate.c kstate.h klisp.h kobject.h kmem.h kstring.h klisp.h \
 	kground.h kenvironment.h kpair.h keval.h koperative.h kground.h \
-	krepl.h kcontinuation.h
+	krepl.h kcontinuation.h kapplicative.h
 kmem.o: kmem.c kmem.h klisp.h kerror.h klisp.h
 kerror.o: kerror.c kerror.h klisp.h kstate.h klisp.h kmem.h kstring.h
 kauxlib.o: kauxlib.c kauxlib.h klisp.h kstate.h klisp.h
diff --git a/src/kgcontinuations.c b/src/kgcontinuations.c
@@ -181,9 +181,6 @@ void guard_continuation(klisp_State *K, TValue *xparams, TValue ptree,
 }
 
 
-/* helper for continuation->applicative */
-void cont_app(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
-
 /* 7.2.5 continuation->applicative */
 /* TODO: look out for guards and dynamic variables */
 void continuation_applicative(klisp_State *K, TValue *xparams, TValue ptree, 
@@ -192,21 +189,11 @@ void continuation_applicative(klisp_State *K, TValue *xparams, TValue ptree,
     UNUSED(xparams);
     bind_1tp(K, "continuation->applicative", ptree, "continuation",
 	     ttiscontinuation, cont);
-
+    /* cont_app is from kstate */
     TValue app = make_applicative(K, cont_app, 1, cont);
     kapply_cc(K, app);
 }
 
-/* this passes the operand tree to the continuation */
-void cont_app(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
-{
-    UNUSED(denv);
-    TValue cont = xparams[0];
-    /* TODO: look out for guards and dynamic variables */
-    /* should be probably handled in kcall_cont() */
-    kcall_cont(K, cont, ptree);
-}
-
 /* 7.2.6 root-continuation */
 /* done in kground.c/krepl.c */
 
diff --git a/src/kstate.c b/src/kstate.c
@@ -19,6 +19,7 @@
 #include "kmem.h"
 #include "keval.h"
 #include "koperative.h"
+#include "kapplicative.h"
 #include "kcontinuation.h"
 #include "kenvironment.h"
 #include "kground.h"
@@ -311,6 +312,15 @@ TValue create_interception_list(klisp_State *K, TValue src_cont,
     return kcdr(dummy);
 }
 
+/* this passes the operand tree to the continuation */
+void cont_app(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(denv);
+    TValue cont = xparams[0];
+    /* guards and dynamic variables are handled in kcall_cont() */
+    kcall_cont(K, cont, ptree);
+}
+
 void do_interception(klisp_State *K, TValue *xparams, TValue obj)
 {
     /* 
@@ -333,16 +343,19 @@ void do_interception(klisp_State *K, TValue *xparams, TValue obj)
 
 	longjmp(K->error_jb, 1);
     } else {
+	/* call the operative with the passed obj and applicative
+	   for outer cont as ptree in the dynamic environment of 
+	   the corresponding call to guard-continuation in the 
+	   dynamic extent of the associated outer continuation */
 	TValue first = kcar(ls);
 	TValue op = kcar(first);
 	TValue outer = kcadr(first);
 	TValue denv = kcddr(first);
-	/* call the operative with the passed obj as ptree in 
-	   the dynamic environment of the corresponding call
-	   to guard-continuation in the dynamic extent of the
-	   associated outer continuation */
+	TValue app = kwrap(K, kmake_operative(K, KNIL, KNIL, 
+					      cont_app, 1, outer));
+	TValue ptree = kcons(K, obj, kcons(K, app, KNIL));
 	kset_cc(K, outer);
-	ktail_call(K, op, obj, denv);
+	ktail_call(K, op, ptree, denv);
     }
 }
 
diff --git a/src/kstate.h b/src/kstate.h
@@ -300,6 +300,8 @@ inline void klispS_tail_call(klisp_State *K, TValue top, TValue ptree,
     { klisp_State *K__ = (K_); \
 	klispS_tail_call(K__, K__->eval_op, (p_), (e_)); return; }
 
+/* helper for continuation->applicative & kcall_cont */
+void cont_app(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void kcall_cont(klisp_State *K, TValue dst_cont, TValue obj);
 void klispS_init_repl(klisp_State *K);
 void klispS_run(klisp_State *K);