refactor error object

debug.c

@@ -36,37 +36,32 @@ pic_get_backtrace(pic_state *pic)
 }
 
 void
-pic_print_backtrace(pic_state *pic, struct pic_error *e)
+pic_print_backtrace(pic_state *pic)
 {
   size_t ai = pic_gc_arena_preserve(pic);
   pic_str *trace;
 
-  assert(pic->err != NULL);
+  assert(! pic_undef_p(pic->err));
 
-  trace = pic_make_str(pic, NULL, 0);
+  if (! pic_error_p(pic->err)) {
+    trace = pic_format(pic, "raised: ~s", pic->err);
+  } else {
+    struct pic_error *e;
 
-  switch (e->type) {
+    e = pic_error_ptr(pic->err);
-  case PIC_ERROR_OTHER:
+    if (e->type != pic_intern_cstr(pic, "")) {
-    trace = pic_strcat(pic, trace, pic_make_str_cstr(pic, "error: "));
+      trace = pic_format(pic, "~s ", pic_sym_value(e->type));
-    break;
+    } else {
-  case PIC_ERROR_FILE:
+      trace = pic_make_str(pic, NULL, 0);
-    trace = pic_strcat(pic, trace, pic_make_str_cstr(pic, "file error: "));
+    }
-    break;
+    trace = pic_strcat(pic, trace, pic_format(pic, "error: ~s", pic_obj_value(e->msg)));
-  case PIC_ERROR_READ:
+
-    trace = pic_strcat(pic, trace, pic_make_str_cstr(pic, "read error: "));
+    /* TODO: print error irritants */
-    break;
+
-  case PIC_ERROR_RAISED:
+    trace = pic_strcat(pic, trace, pic_make_str(pic, "\n", 1));
-    trace = pic_strcat(pic, trace, pic_make_str_cstr(pic, "raised: "));
+    trace = pic_strcat(pic, trace, e->stack);
-    break;
   }
 
-  trace = pic_strcat(pic, trace, e->msg);
-
-  /* TODO: print error irritants */
-
-  trace = pic_strcat(pic, trace, pic_make_str(pic, "\n", 1));
-  trace = pic_strcat(pic, trace, e->stack);
-
   /* print! */
   printf("%s", pic_str_cstr(trace));
 

error.c

@@ -89,37 +89,51 @@ make_error(pic_state *pic, short type, pic_str *msg, pic_value irrs)
 }
 
 noreturn void
-pic_throw_error(pic_state *pic, struct pic_error *e)
+pic_raise(pic_state *pic, pic_value err)
 {
   void pic_vm_tear_off(pic_state *);
 
   pic_vm_tear_off(pic);         /* tear off */
 
-  pic->err = e;
+  pic->err = err;
   if (! pic->jmp) {
     puts(pic_errmsg(pic));
-    abort();
+    pic_abort(pic, "no handler found on stack");
   }
 
   longjmp(*pic->jmp, 1);
 }
 
 noreturn void
-pic_throw(pic_state *pic, short type, const char *msg, pic_value irrs)
+pic_throw(pic_state *pic, pic_sym type, const char *msg, pic_value irrs)
 {
   struct pic_error *e;
 
   e = make_error(pic, type, pic_make_str_cstr(pic, msg), irrs);
 
-  pic_throw_error(pic, e);
+  pic_raise(pic, pic_obj_value(e));
+}
+
+noreturn void
+pic_error(pic_state *pic, const char *msg, pic_value irrs)
+{
+  pic_throw(pic, pic_intern_cstr(pic, ""), msg, irrs);
 }
 
 const char *
 pic_errmsg(pic_state *pic)
 {
-  assert(pic->err != NULL);
+  pic_str *str;
 
-  return pic_str_cstr(pic->err->msg);
+  assert(! pic_undef_p(pic->err));
+
+  if (! pic_error_p(pic->err)) {
+    str = pic_format(pic, "~s", pic->err);
+  } else {
+    str = pic_error_ptr(pic->err)->msg;
+  }
+
+  return pic_str_cstr(str);
 }
 
 void
@@ -136,34 +150,30 @@ pic_errorf(pic_state *pic, const char *fmt, ...)
   msg = pic_str_cstr(pic_str_ptr(pic_car(pic, err_line)));
   irrs = pic_cdr(pic, err_line);
 
-  pic_throw(pic, PIC_ERROR_OTHER, msg, irrs);
+  pic_error(pic, msg, irrs);
 }
 
 static pic_value
 pic_error_with_exception_handler(pic_state *pic)
 {
   struct pic_proc *handler, *thunk;
-  pic_value v;
+  pic_value val;
 
   pic_get_args(pic, "ll", &handler, &thunk);
 
   pic_try_with_handler(handler) {
-    v = pic_apply0(pic, thunk);
+    val = pic_apply0(pic, thunk);
   }
   pic_catch {
-    struct pic_error *e = pic->err;
+    pic_value e = pic->err;
 
-    pic->err = NULL;
+    pic->err = pic_undef_value();
 
-    if (e->type == PIC_ERROR_RAISED) {
+    val = pic_apply1(pic, handler, e);
-      v = pic_list_ref(pic, e->irrs, 0);
+
-    } else {
+    pic_errorf(pic, "error handler returned with ~s on error ~s", val, e);
-      v = pic_obj_value(e);
-    }
-    v = pic_apply1(pic, handler, v);
-    pic_errorf(pic, "error handler returned ~s, by error ~s", v, pic_obj_value(e));
   }
-  return v;
+  return val;
 }
 
 noreturn static pic_value
@@ -173,7 +183,7 @@ pic_error_raise(pic_state *pic)
 
   pic_get_args(pic, "o", &v);
 
-  pic_throw(pic, PIC_ERROR_RAISED, "object is raised", pic_list1(pic, v));
+  pic_raise(pic, v);
 }
 
 static pic_value
@@ -206,7 +216,7 @@ pic_error_error(pic_state *pic)
 
   pic_get_args(pic, "z*", &str, &argc, &argv);
 
-  pic_throw(pic, PIC_ERROR_OTHER, str, pic_list_by_array(pic, argc, argv));
+  pic_error(pic, str, pic_list_by_array(pic, argc, argv));
 }
 
 static pic_value
@@ -252,7 +262,8 @@ pic_error_read_error_p(pic_state *pic)
   }
 
   e = pic_error_ptr(v);
-  return pic_bool_value(e->type == PIC_ERROR_READ);
+
+  return pic_bool_value(e->type == pic->sREAD);
 }
 
 static pic_value
@@ -268,7 +279,8 @@ pic_error_file_error_p(pic_state *pic)
   }
 
   e = pic_error_ptr(v);
-  return pic_bool_value(e->type == PIC_ERROR_FILE);
+
+  return pic_bool_value(e->type == pic->sFILE);
 }
 
 void

file.c

@@ -9,7 +9,7 @@
 static noreturn void
 file_error(pic_state *pic, const char *msg)
 {
-  pic_throw(pic, PIC_ERROR_FILE, msg, pic_nil_value());
+  pic_throw(pic, pic->sFILE, msg, pic_nil_value());
 }
 
 static pic_value

gc.c

@@ -580,9 +580,7 @@ gc_mark_phase(pic_state *pic)
   }
 
   /* error object */
-  if (pic->err) {
+  gc_mark(pic, pic->err);
-    gc_mark_object(pic, (struct pic_object *)pic->err);
-  }
 
   /* arena */
   for (j = 0; j < pic->arena_idx; ++j) {

include/picrin.h

@@ -81,6 +81,7 @@ typedef struct {
   pic_sym sCONS, sCAR, sCDR, sNILP;
   pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
   pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT;
+  pic_sym sREAD, sFILE;
 
   pic_sym rDEFINE, rLAMBDA, rIF, rBEGIN, rQUOTE, rSETBANG;
   pic_sym rDEFINE_SYNTAX, rIMPORT, rEXPORT;
@@ -104,7 +105,7 @@ typedef struct {
   struct pic_reader *reader;
 
   jmp_buf *jmp;
-  struct pic_error *err;
+  pic_value err;
   struct pic_jmpbuf *try_jmps;
   size_t try_jmp_size, try_jmp_idx;
 
@@ -206,7 +207,7 @@ noreturn void pic_abort(pic_state *, const char *);
 noreturn void pic_errorf(pic_state *, const char *, ...);
 void pic_warnf(pic_state *, const char *, ...);
 pic_str *pic_get_backtrace(pic_state *);
-void pic_print_backtrace(pic_state *, struct pic_error *);
+void pic_print_backtrace(pic_state *);
 
 /* obsoleted */
 static inline void pic_warn(pic_state *pic, const char *msg)

include/picrin/error.h

@@ -34,18 +34,14 @@ struct pic_jmpbuf {
 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);
+noreturn void pic_raise(pic_state *, pic_value);
-noreturn void pic_throw_error(pic_state *, struct pic_error *);
+noreturn void pic_throw(pic_state *, pic_sym, const char *, pic_list);
+noreturn void pic_error(pic_state *, const char *, pic_list);
 
 struct pic_error {
   PIC_OBJECT_HEADER
-  enum pic_error_kind {
+  pic_sym type;
-    PIC_ERROR_OTHER,
+  pic_str *msg;
-    PIC_ERROR_FILE,
-    PIC_ERROR_READ,
-    PIC_ERROR_RAISED
-  } type;
-  struct pic_string *msg;
   pic_value irrs;
   pic_str *stack;
 };

include/picrin/value.h

@@ -142,6 +142,7 @@ struct pic_blob;
 
 struct pic_proc;
 struct pic_port;
+struct pic_error;
 
 /* set aliases to basic types */
 typedef pic_value pic_list;

lib.c

@@ -318,7 +318,7 @@ pic_lib_define_library(pic_state *pic)
   }
   pic_catch {
     pic_in_library(pic, prev->name); /* restores pic->lib even if an error occurs */
-    pic_throw_error(pic, pic->err);
+    pic_raise(pic, pic->err);
   }
 
   return pic_none_value();

read.c

@@ -21,7 +21,7 @@ static pic_value read_nullable(pic_state *pic, struct pic_port *port, int c);
 static noreturn void
 read_error(pic_state *pic, const char *msg)
 {
-  pic_throw(pic, PIC_ERROR_READ, msg, pic_nil_value());
+  pic_throw(pic, pic->sREAD, msg, pic_nil_value());
 }
 
 static int

state.c

@@ -72,7 +72,7 @@ pic_open(int argc, char *argv[], char **envp)
 
   /* error handling */
   pic->jmp = NULL;
-  pic->err = NULL;
+  pic->err = pic_undef_value();
   pic->try_jmps = calloc(PIC_RESCUE_SIZE, sizeof(struct pic_jmpbuf));
   pic->try_jmp_idx = 0;
   pic->try_jmp_size = PIC_RESCUE_SIZE;
@@ -131,6 +131,8 @@ pic_open(int argc, char *argv[], char **envp)
   S(sGT, ">");
   S(sGE, ">=");
   S(sNOT, "not");
+  S(sREAD, "read");
+  S(sFILE, "file");
   pic_gc_arena_restore(pic, ai);
 
 #define R(slot,name) pic->slot = pic_gensym(pic, pic_intern_cstr(pic, name));
@@ -191,7 +193,7 @@ pic_close(pic_state *pic)
   pic->sp = pic->stbase;
   pic->ci = pic->cibase;
   pic->arena_idx = 0;
-  pic->err = NULL;
+  pic->err = pic_undef_value();
   xh_clear(&pic->macros);
   pic->features = pic_nil_value();
   pic->libs = pic_nil_value();