From b8b5743589ccbed555805d768d5c840aad350499 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Fri, 5 Sep 2014 14:15:46 +0900
Subject: [PATCH] continuation object is applicable

---
 cont.c                | 42 +++++++++++++++++++++++-------------------
 include/picrin/cont.h |  1 +
 vm.c                  |  8 ++++++++
 3 files changed, 32 insertions(+), 19 deletions(-)

diff --git a/cont.c b/cont.c
index 23e5de3d..76760caf 100644
--- a/cont.c
+++ b/cont.c
@@ -250,25 +250,6 @@ pic_dynamic_wind(pic_state *pic, struct pic_proc *in, struct pic_proc *thunk, st
   return val;
 }
 
-noreturn static pic_value
-pic_cont_continue(pic_state *pic)
-{
-  struct pic_proc *proc;
-  size_t argc;
-  pic_value cont, *argv;
-
-  proc = pic_get_proc(pic);
-  pic_get_args(pic, "o*", &cont, &argc, &argv);
-
-  pic_assert_type(pic, cont, cont);
-
-  pic_cont_ptr(cont)->results = pic_list_by_array(pic, argc, argv);
-
-  /* execute guard handlers */
-  walk_to_block(pic, pic->blk, pic_cont_ptr(cont)->blk);
-
-  restore_cont(pic, pic_cont_ptr(cont));
-}
 
 pic_value
 pic_callcc(pic_state *pic, struct pic_proc *proc)
@@ -298,6 +279,16 @@ pic_callcc_trampoline(pic_state *pic, struct pic_proc *proc)
   }
 }
 
+noreturn void
+pic_continue(pic_state *pic, struct pic_cont *cont, size_t argc, pic_value *argv)
+{
+  cont->results = pic_list_by_array(pic, argc, argv);
+
+  walk_to_block(pic, pic->blk, cont->blk);
+
+  restore_cont(pic, cont);
+}
+
 static pic_value
 pic_cont_callcc(pic_state *pic)
 {
@@ -308,6 +299,19 @@ pic_cont_callcc(pic_state *pic)
   return pic_callcc_trampoline(pic, cb);
 }
 
+noreturn static pic_value
+pic_cont_continue(pic_state *pic)
+{
+  size_t argc;
+  pic_value cont, *argv;
+
+  pic_get_args(pic, "o*", &cont, &argc, &argv);
+
+  pic_assert_type(pic, cont, cont);
+
+  pic_continue(pic, pic_cont_ptr(cont), argc, argv);
+}
+
 static pic_value
 pic_cont_dynamic_wind(pic_state *pic)
 {
diff --git a/include/picrin/cont.h b/include/picrin/cont.h
index 6f35de38..ac5213eb 100644
--- a/include/picrin/cont.h
+++ b/include/picrin/cont.h
@@ -57,6 +57,7 @@ pic_value pic_values_by_list(pic_state *, pic_value);
 size_t pic_receive(pic_state *, size_t, pic_value *);
 
 pic_value pic_callcc(pic_state *, struct pic_proc *);
+noreturn void pic_continue(pic_state *, struct pic_cont *, size_t, pic_value *);
 
 #if defined(__cplusplus)
 }
diff --git a/vm.c b/vm.c
index d25a2656..46034214 100644
--- a/vm.c
+++ b/vm.c
@@ -21,6 +21,7 @@
 #include "picrin/error.h"
 #include "picrin/dict.h"
 #include "picrin/record.h"
+#include "picrin/cont.h"
 
 #define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
 
@@ -752,6 +753,13 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
           PUSH(pic_var_ref(pic, pic_var_ptr(x)));
           NEXT;
         }
+        if (pic_cont_p(x)) {
+          if (c.u.i >= 1) {
+            pic_errorf(pic, "invalid call-sequence for cont object");
+          }
+          pic_continue(pic, pic_cont_ptr(x), c.u.i - 1, pic->sp - c.u.i + 1);
+          UNREACHABLE();
+        }
 	pic_errorf(pic, "invalid application: ~s", x);
       }
       proc = pic_proc_ptr(x);