From 70ace29b7c50d5b7f79a89af862751d5c30693b7 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sun, 29 Jun 2014 17:44:55 +0900
Subject: [PATCH] initial raise-continuable support

---
 include/picrin/error.h |  7 +++++--
 src/error.c            | 29 +++++++++++++++++++++++++++--
 2 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/include/picrin/error.h b/include/picrin/error.h
index 41444dc6..cbaff543 100644
--- a/include/picrin/error.h
+++ b/include/picrin/error.h
@@ -11,6 +11,7 @@ extern "C" {
 
 struct pic_jmpbuf {
   jmp_buf here;
+  struct pic_proc *handler;
   pic_callinfo *ci;
   pic_value *sp;
   pic_code *ip;
@@ -20,7 +21,9 @@ struct pic_jmpbuf {
 /* do not return from try block! */
 
 #define pic_try                                 \
-  pic_push_try(pic);                            \
+  pic_try_with_handler(NULL)
+#define pic_try_with_handler(handler)           \
+  pic_push_try(pic, handler);                   \
   if (setjmp(*pic->jmp) == 0)                   \
     do
 #define pic_catch                               \
@@ -28,7 +31,7 @@ struct pic_jmpbuf {
   else                                          \
     if (pic_pop_try(pic), 1)
 
-void pic_push_try(pic_state *);
+void pic_push_try(pic_state *, struct pic_proc *);
 void pic_pop_try(pic_state *);
 
 noreturn void pic_throw(pic_state *, short, const char *, pic_value);
diff --git a/src/error.c b/src/error.c
index bc45ff65..b5ed169e 100644
--- a/src/error.c
+++ b/src/error.c
@@ -34,7 +34,7 @@ pic_warnf(pic_state *pic, const char *fmt, ...)
 }
 
 void
-pic_push_try(pic_state *pic)
+pic_push_try(pic_state *pic, struct pic_proc *handler)
 {
   struct pic_jmpbuf *try_jmp;
 
@@ -45,6 +45,8 @@ pic_push_try(pic_state *pic)
 
   try_jmp = pic->try_jmps + pic->try_jmp_idx++;
 
+  try_jmp->handler = handler;
+
   try_jmp->ci = pic->ci;
   try_jmp->sp = pic->sp;
   try_jmp->ip = pic->ip;
@@ -140,7 +142,7 @@ pic_error_with_exception_handler(pic_state *pic)
 
   pic_get_args(pic, "ll", &handler, &thunk);
 
-  pic_try {
+  pic_try_with_handler(handler) {
     v = pic_apply0(pic, thunk);
   }
   pic_catch {
@@ -169,6 +171,28 @@ pic_error_raise(pic_state *pic)
   pic_throw(pic, PIC_ERROR_RAISED, "object is raised", pic_list1(pic, v));
 }
 
+static pic_value
+pic_error_raise_continuable(pic_state *pic)
+{
+  pic_value v;
+  size_t i;
+
+  pic_get_args(pic, "o", &v);
+
+  if (pic->try_jmps->handler == NULL) {
+    pic_errorf(pic, "uncontinuable exception handler is on top");
+  }
+  if ((i = pic->try_jmp_idx) == 0) {
+    pic_errorf(pic, "no exception handler registered");
+  }
+  else {
+    pic->try_jmp_idx--;
+    v = pic_apply1(pic, pic->try_jmps->handler, v);
+    ++pic->try_jmp_idx;
+  }
+  return v;
+}
+
 noreturn static pic_value
 pic_error_error(pic_state *pic)
 {
@@ -248,6 +272,7 @@ pic_init_error(pic_state *pic)
 {
   pic_defun(pic, "with-exception-handler", pic_error_with_exception_handler);
   pic_defun(pic, "raise", pic_error_raise);
+  pic_defun(pic, "raise-continuable", pic_error_raise_continuable);
   pic_defun(pic, "error", pic_error_error);
   pic_defun(pic, "error-object?", pic_error_error_object_p);
   pic_defun(pic, "error-object-message", pic_error_error_object_message);