add error function

include/picrin/pair.h

@@ -7,6 +7,7 @@ pic_value pic_cdr(pic_state *, pic_value);
 
 bool pic_list_p(pic_state *, pic_value);
 pic_value pic_list(pic_state *, size_t, ...);
+pic_value pic_list_from_array(pic_state *, size_t, pic_value *);
 
 int pic_length(pic_state *, pic_value);
 pic_value pic_reverse(pic_state *, pic_value);

src/error.c

@@ -1,7 +1,9 @@
 #include <stdlib.h>
 #include <stdio.h>
+#include <string.h>
 
 #include "picrin.h"
+#include "picrin/pair.h"
 #include "picrin/proc.h"
 #include "picrin/error.h"
 
@@ -25,7 +27,8 @@ pic_errorf(pic_state *pic, const char *msg, size_t n, ...)
 void
 pic_abort(pic_state *pic, const char *msg)
 {
-  puts(msg);
+  fprintf(stderr, "abort: %s\n", msg);
+  fflush(stderr);
   abort();
 }
 
@@ -114,6 +117,26 @@ pic_error_raise_continuable(pic_state *pic)
   return a;
 }
 
+static pic_value
+pic_error_error(pic_state *pic)
+{
+  char *str;
+  int len, argc;
+  pic_value *argv;
+  struct pic_error *e;
+
+  pic_get_args(pic, "s*", &str, &len, &argc, &argv);
+
+  e = (struct pic_error *)pic_obj_alloc(pic, sizeof(struct pic_error), PIC_TT_ERROR);
+  e->type = PIC_ERROR_OTHER;
+  e->msg = strdup(str);
+  e->irrs = pic_list_from_array(pic, argc, argv);
+
+  pic_raise(pic, pic_obj_value(e));
+
+  /* never returns */
+  return pic_undef_value();
+}
 static pic_value
 pic_error_error_object_p(pic_state *pic)
 {
@@ -182,6 +205,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);
   pic_defun(pic, "error-object-irritants", pic_error_error_object_irritants);

src/pair.c

@@ -67,6 +67,19 @@ pic_list(pic_state *pic, size_t c, ...)
   return pic_reverse(pic, v);
 }
 
+pic_value
+pic_list_from_array(pic_state *pic, size_t c, pic_value *vs)
+{
+  pic_value v;
+  int i;
+
+  v = pic_nil_value();
+  for (i = 0; i < c; ++i) {
+    v = pic_cons(pic, vs[i], v);
+  }
+  return pic_reverse(pic, v);
+}
+
 int
 pic_length(pic_state *pic, pic_value obj)
 {