Merge branch 'throw-in-catch'

include/picrin.h

@@ -104,6 +104,7 @@ typedef struct {
 
   jmp_buf *jmp;
   struct pic_error *err;
+  struct pic_jmpbuf *try_jmps;
 
   struct pic_heap *heap;
   struct pic_object *arena[PIC_ARENA_SIZE];
@@ -134,15 +135,6 @@ void pic_define(pic_state *, const char *, pic_value); /* automatic export */
 pic_value pic_ref(pic_state *, const char *);
 void pic_set(pic_state *, const char *, pic_value);
 
-#define pic_try                                                 \
-  pic_try_helper__(GENSYM(i), GENSYM(here), GENSYM(prev_jmp))
-#define pic_try_helper__(i, here, prev_jmp)                             \
-  for (int i = 0; ! i; )                                                \
-    for (jmp_buf here, *prev_jmp = pic->jmp; ! i; )                     \
-      for (pic->jmp = &here; ! i++; pic->jmp = prev_jmp)                \
-        if (setjmp(here) == 0)
-#define pic_catch else
-
 struct pic_proc *pic_get_proc(pic_state *);
 int pic_get_args(pic_state *, const char *, ...);
 void pic_defun(pic_state *, const char *, pic_func_t);

include/picrin/error.h

@@ -9,6 +9,24 @@
 extern "C" {
 #endif
 
+struct pic_jmpbuf {
+  jmp_buf here;
+  jmp_buf *prev_jmp;
+  struct pic_jmpbuf *prev;
+};
+
+#define pic_try                                 \
+  pic_push_try(pic);                            \
+  if (setjmp(*pic->jmp) == 0)                   \
+    do
+#define pic_catch                               \
+    while (pic_pop_try(pic), 0);                \
+  else                                          \
+    if (pic_pop_try(pic), 1)
+
+void pic_push_try(pic_state *);
+void pic_pop_try(pic_state *);
+
 struct pic_error {
   PIC_OBJECT_HEADER
   enum pic_error_kind {

src/error.c

@@ -11,6 +11,34 @@
 #include "picrin/string.h"
 #include "picrin/error.h"
 
+void
+pic_push_try(pic_state *pic)
+{
+  struct pic_jmpbuf *try_jmp;
+
+  try_jmp = pic_alloc(pic, sizeof(struct pic_jmpbuf));
+
+  try_jmp->prev_jmp = pic->jmp;
+  pic->jmp = &try_jmp->here;
+
+  try_jmp->prev = pic->try_jmps;
+  pic->try_jmps = try_jmp;
+}
+
+void
+pic_pop_try(pic_state *pic)
+{
+  struct pic_jmpbuf *prev;
+
+  assert(pic->jmp == &pic->try_jmps->here);
+
+  pic->jmp = pic->try_jmps->prev_jmp;
+
+  prev = pic->try_jmps->prev;
+  pic_free(pic, pic->try_jmps);
+  pic->try_jmps = prev;
+}
+
 const char *
 pic_errmsg(pic_state *pic)
 {

src/init.c

@@ -8,6 +8,7 @@
 #include "picrin/pair.h"
 #include "picrin/lib.h"
 #include "picrin/macro.h"
+#include "picrin/error.h"
 
 void pic_init_bool(pic_state *);
 void pic_init_pair(pic_state *);

src/macro.c

@@ -8,6 +8,7 @@
 #include "picrin/proc.h"
 #include "picrin/macro.h"
 #include "picrin/lib.h"
+#include "picrin/error.h"
 
 static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *);
 static pic_value macroexpand_list(pic_state *, pic_value, struct pic_senv *);
@@ -213,47 +214,38 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
 
       if (tag == pic->sDEFINE_LIBRARY) {
         struct pic_lib *prev = pic->lib;
-        jmp_buf jmp, *prevjmp = pic->jmp;
-        bool name_restored = false;
 
-        /* restores pic->lib even if an error occurs */
-        if (setjmp(jmp) == 0) {
-          pic->jmp = &jmp;
-          if (pic_length(pic, expr) < 2) {
-            pic_error(pic, "syntax error");
-          }
-          pic_make_library(pic, pic_cadr(pic, expr));
+        if (pic_length(pic, expr) < 2) {
+          pic_error(pic, "syntax error");
+        }
+        pic_make_library(pic, pic_cadr(pic, expr));
 
-          /* proceed expressions in new library */
+        pic_try {
           pic_in_library(pic, pic_cadr(pic, expr));
-          {
-            int ai = pic_gc_arena_preserve(pic);
-            struct pic_proc *proc;
 
-            pic_for_each (v, pic_cddr(pic, expr)) {
-              proc = pic_compile(pic, v);
-              if (proc == NULL) {
-                abort();
-              }
-              pic_apply_argv(pic, proc, 0);
-              if (pic_undef_p(v)) {
-                abort();
-              }
-              pic_gc_arena_restore(pic, ai);
+          pic_for_each (v, pic_cddr(pic, expr)) {
+            struct pic_proc *proc;
+            int ai = pic_gc_arena_preserve(pic);
+
+            proc = pic_compile(pic, v);
+            if (proc == NULL) {
+              abort();
             }
+            pic_apply_argv(pic, proc, 0);
+            if (pic_undef_p(v)) {
+              abort();
+            }
+            pic_gc_arena_restore(pic, ai);
           }
+
           pic_in_library(pic, prev->name);
-          name_restored = true;
         }
-        else {
-          if (! name_restored) {
-            pic_in_library(pic, prev->name);
-          }
-        }
-        pic->jmp = prevjmp;
-        if (pic->err) {
+        pic_catch {
+          /* restores pic->lib even if an error occurs */
+          pic_in_library(pic, prev->name);
           longjmp(*pic->jmp, 1);
         }
+
         return pic_none_value();
       }
 

src/state.c

@@ -72,6 +72,7 @@ pic_open(int argc, char *argv[], char **envp)
   /* error handling */
   pic->jmp = NULL;
   pic->err = NULL;
+  pic->try_jmps = NULL;
 
   /* GC arena */
   pic->arena_idx = 0;

tools/main.c

@@ -9,6 +9,7 @@
 
 #include "picrin.h"
 #include "picrin/pair.h"
+#include "picrin/error.h"
 
 #if PIC_ENABLE_READLINE
 # include <readline/readline.h>