support error objects in the display procedure and remove pic_print_error

lib/Makefile

@@ -4,7 +4,6 @@ LIBPICRIN_SRCS = \
 	char.c\
 	cont.c\
 	data.c\
-	debug.c\
 	dict.c\
 	error.c\
 	gc.c\

lib/debug.c

@@ -1,33 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#include "picrin.h"
-#include "object.h"
-#include "state.h"
-
-#if PIC_USE_WRITE
-
-void
-pic_print_error(pic_state *pic, pic_value port, pic_value err)
-{
-  if (! pic_error_p(pic, err)) {
-    pic_fprintf(pic, port, "raise: ~s", err);
-  } else {
-    struct error *e;
-    pic_value elem, it;
-
-    e = error_ptr(pic, err);
-    if (! pic_eq_p(pic, obj_value(pic, e->type), pic_intern_lit(pic, ""))) {
-      pic_fprintf(pic, port, "~s-", obj_value(pic, e->type));
-    }
-    pic_fprintf(pic, port, "error: ~s", obj_value(pic, e->msg));
-
-    pic_for_each (elem, e->irrs, it) { /* print error irritants */
-      pic_fprintf(pic, port, " ~s", elem);
-    }
-    pic_fprintf(pic, port, "\n");
-  }
-}
-
-#endif

lib/ext/main.c

@@ -69,7 +69,7 @@ main(int argc, char *argv[])
     }
   }
   pic_catch(e) {
-    pic_print_error(pic, pic_stderr(pic), e);
+    pic_funcall(pic, "display", 2, e, pic_stderr(pic));
   }
 
   pic_close(pic);

lib/ext/write.c

@@ -296,6 +296,33 @@ write_record(pic_state *pic, pic_value obj, pic_value port, struct writer_contro
   pic_fprintf(pic, port, ">");
 }
 
+static void
+write_error(pic_state *pic, pic_value err, pic_value port, struct writer_control *p)
+{
+  if (p->mode == WRITE_MODE) {
+    pic_fprintf(pic, port, "#<error %p>", obj_ptr(pic, err));
+    return;
+  }
+
+  if (! pic_error_p(pic, err)) {
+    pic_fprintf(pic, port, "raise: ~s", err);
+  } else {
+    struct error *e;
+    pic_value elem, it;
+
+    e = error_ptr(pic, err);
+    if (! pic_eq_p(pic, obj_value(pic, e->type), pic_intern_lit(pic, ""))) {
+      pic_fprintf(pic, port, "~s-", obj_value(pic, e->type));
+    }
+    pic_fprintf(pic, port, "error: \"~a\"", obj_value(pic, e->msg));
+
+    pic_for_each (elem, e->irrs, it) { /* print error irritants */
+      pic_fprintf(pic, port, " ~s", elem);
+    }
+    pic_fprintf(pic, port, "\n");
+  }
+}
+
 static const char *
 typename(pic_state *pic, pic_value obj)
 {
@@ -414,6 +441,9 @@ write_core(pic_state *pic, pic_value obj, pic_value port, struct writer_control
   case PIC_TYPE_RECORD:
     write_record(pic, obj, port, p);
     break;
+  case PIC_TYPE_ERROR:
+    write_error(pic, obj, port, p);
+    break;
   default:
     pic_fprintf(pic, port, "#<%s %p>", typename(pic, obj), obj_ptr(pic, obj));
     break;

lib/include/picrin/extra.h

@@ -17,12 +17,6 @@ void *pic_default_allocf(void *, void *, size_t);
 pic_value pic_fopen(pic_state *, FILE *, const char *mode);
 #endif
 
-/* for debug */
-
-#if PIC_USE_WRITE
-void pic_print_error(pic_state *, pic_value port, pic_value err);
-#endif
-
 #if defined(__cplusplus)
 }
 #endif

src/main.c

@@ -42,7 +42,7 @@ main(int argc, char *argv[], char **envp)
     status = 0;
   }
   pic_catch(e) {
-    pic_print_error(pic, pic_stderr(pic), e);
+    pic_funcall(pic, "display", 2, e, pic_stderr(pic));
     status = 1;
   }