pic_strf_value does not interpret '~s' format specifier

contrib/60.repl/repl.scm

@@ -54,6 +54,10 @@
         (get-output-string port))))
 
   (define (print-error-object e)
+    (define type (error-object-type e))
+    (unless (eq? type '||)
+      (display type)
+      (display "-"))
     (display "error: ")
     (display (error-object-message e))
     (display ".")
@@ -81,7 +85,7 @@
                           (print-error-object condition)
                           (set! str ""))
                         (begin
-                          (display "raised: ")
+                          (display "raise: ")
                           (write condition)
                           (newline)
                           (set! str "")))

extlib/benz/debug.c

@@ -36,30 +36,29 @@ pic_get_backtrace(pic_state *pic)
 }
 
 void
-pic_print_backtrace(pic_state *pic, xFILE *file)
+pic_print_error(pic_state *pic, xFILE *file)
 {
-  pic_value err = pic_err(pic);
+  pic_value err = pic_err(pic), port = pic_open_port(pic, file);
 
   assert(! pic_invalid_p(pic, err));
 
   if (! pic_error_p(pic, err)) {
     xfprintf(pic, file, "raise: ");
-    pic_fwrite(pic, err, file);
+    pic_fprintf(pic, port, "~s", err);
   } else {
     struct error *e;
     pic_value elem, it;
 
     e = pic_error_ptr(pic, err);
     if (! pic_eq_p(pic, pic_obj_value(e->type), pic_intern_lit(pic, ""))) {
-      pic_fwrite(pic, pic_obj_value(e->type), file);
+      pic_fprintf(pic, port, "~s", pic_obj_value(e->type));
       xfprintf(pic, file, " ");
     }
     xfprintf(pic, file, "error: ");
-    pic_fwrite(pic, pic_obj_value(e->msg), file);
+    pic_fprintf(pic, port, "~s", pic_obj_value(e->msg));
 
     pic_for_each (elem, e->irrs, it) { /* print error irritants */
-      xfprintf(pic, file, " ");
-      pic_fwrite(pic, elem, file);
+      pic_fprintf(pic, port, " ~s", elem);
     }
     xfprintf(pic, file, "\n");
 

extlib/benz/include/picrin/extra.h

@@ -23,6 +23,10 @@ pic_value pic_eval(pic_state *, pic_value program, const char *lib);
 void pic_load(pic_state *, pic_value port);
 void pic_load_cstr(pic_state *, const char *);
 
+void pic_printf(pic_state *, const char *fmt, ...);
+void pic_fprintf(pic_state *, pic_value port, const char *fmt, ...);
+void pic_vfprintf(pic_state *, pic_value port, const char *fmt, va_list ap);
+
 /* extra xfile methods */
 
 xFILE *xfile_xstdin(pic_state *);
@@ -43,12 +47,6 @@ xFILE *xfopen_null(pic_state *, const char *mode);
 #define pic_stdin(pic) pic_funcall(pic, "picrin.base", "current-input-port", 0)
 #define pic_stdout(pic) pic_funcall(pic, "picrin.base", "current-output-port", 0)
 #define pic_stderr(pic) pic_funcall(pic, "picrin.base", "current-error-port", 0)
-pic_value pic_write(pic_state *, pic_value); /* returns given obj */
-pic_value pic_fwrite(pic_state *, pic_value, xFILE *);
-void pic_printf(pic_state *, const char *, ...);
-void pic_fprintf(pic_state *, pic_value port, const char *, ...);
-pic_value pic_display(pic_state *, pic_value);
-pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
 
 /* utility macros */
 
@@ -111,7 +109,7 @@ pic_value pic_err(pic_state *);
 
 void pic_warnf(pic_state *, const char *, ...);
 pic_value pic_get_backtrace(pic_state *);
-void pic_print_backtrace(pic_state *, xFILE *);
+void pic_print_error(pic_state *, xFILE *);
 
 pic_value pic_library_environment(pic_state *, const char *);
 

extlib/benz/string.c

@@ -318,72 +318,6 @@ pic_str(pic_state *pic, pic_value str)
   return rope_cstr(pic, pic_str_ptr(pic, str)->rope);
 }
 
-static void
-vfstrf(pic_state *pic, xFILE *file, const char *fmt, va_list ap)
-{
-  char c;
-
-  while ((c = *fmt++) != '\0') {
-    switch (c) {
-    default:
-      xfputc(pic, c, file);
-      break;
-    case '%':
-      c = *fmt++;
-      if (! c)
-        goto exit;
-      switch (c) {
-      default:
-        xfputc(pic, c, file);
-        break;
-      case '%':
-        xfputc(pic, '%', file);
-        break;
-      case 'c':
-        xfprintf(pic, file, "%c", va_arg(ap, int));
-        break;
-      case 's':
-        xfprintf(pic, file, "%s", va_arg(ap, const char *));
-        break;
-      case 'd':
-        xfprintf(pic, file, "%d", va_arg(ap, int));
-        break;
-      case 'p':
-        xfprintf(pic, file, "%p", va_arg(ap, void *));
-        break;
-      case 'f':
-        xfprintf(pic, file, "%f", va_arg(ap, double));
-        break;
-      }
-      break;
-    case '~':
-      c = *fmt++;
-      if (! c)
-        goto exit;
-      switch (c) {
-      default:
-        xfputc(pic, c, file);
-        break;
-      case '~':
-        xfputc(pic, '~', file);
-        break;
-      case '%':
-        xfputc(pic, '\n', file);
-        break;
-      case 'a':
-        pic_fdisplay(pic, va_arg(ap, pic_value), file);
-        break;
-      case 's':
-        pic_fwrite(pic, va_arg(ap, pic_value), file);
-        break;
-      }
-      break;
-    }
-  }
- exit:
-  return;
-}
-
 pic_value
 pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
 {
@@ -394,7 +328,7 @@ pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
 
   file = xfopen_buf(pic, NULL, 0, "w");
 
-  vfstrf(pic, file, fmt, ap);
+  xvfprintf(pic, file, fmt, ap);
   xfget_buf(pic, file, &buf, &len);
   str = pic_str_value(pic, buf, len);
   xfclose(pic, file);

extlib/benz/write.c

@@ -366,44 +366,70 @@ write(pic_state *pic, pic_value obj, xFILE *file, int mode, int op)
   write_core(pic, obj, file, &p);
 }
 
-
-pic_value
-pic_write(pic_state *pic, pic_value obj)
-{
-  return pic_fwrite(pic, obj, pic_fileno(pic, pic_stdout(pic)));
-}
-
-pic_value
-pic_fwrite(pic_state *pic, pic_value obj, xFILE *file)
-{
-  write(pic, obj, file, WRITE_MODE, OP_WRITE);
-  xfflush(pic, file);
-  return obj;
-}
-
-pic_value
-pic_display(pic_state *pic, pic_value obj)
-{
-  return pic_fdisplay(pic, obj, pic_fileno(pic, pic_stdout(pic)));
-}
-
-pic_value
-pic_fdisplay(pic_state *pic, pic_value obj, xFILE *file)
-{
-  write(pic, obj, file, DISPLAY_MODE, OP_WRITE);
-  xfflush(pic, file);
-  return obj;
-}
-
 void
 pic_vfprintf(pic_state *pic, pic_value port, const char *fmt, va_list ap)
 {
   xFILE *file = pic_fileno(pic, port);
-  pic_value str;
+  char c;
 
-  str = pic_vstrf_value(pic, fmt, ap);
-
-  xfprintf(pic, file, "%s", pic_str(pic, str));
+  while ((c = *fmt++) != '\0') {
+    switch (c) {
+    default:
+      xfputc(pic, c, file);
+      break;
+    case '%':
+      c = *fmt++;
+      if (! c)
+        goto exit;
+      switch (c) {
+      default:
+        xfputc(pic, c, file);
+        break;
+      case '%':
+        xfputc(pic, '%', file);
+        break;
+      case 'c':
+        xfprintf(pic, file, "%c", va_arg(ap, int));
+        break;
+      case 's':
+        xfprintf(pic, file, "%s", va_arg(ap, const char *));
+        break;
+      case 'd':
+        xfprintf(pic, file, "%d", va_arg(ap, int));
+        break;
+      case 'p':
+        xfprintf(pic, file, "%p", va_arg(ap, void *));
+        break;
+      case 'f':
+        xfprintf(pic, file, "%f", va_arg(ap, double));
+        break;
+      }
+      break;
+    case '~':
+      c = *fmt++;
+      if (! c)
+        goto exit;
+      switch (c) {
+      default:
+        xfputc(pic, c, file);
+        break;
+      case '~':
+        xfputc(pic, '~', file);
+        break;
+      case '%':
+        xfputc(pic, '\n', file);
+        break;
+      case 'a':
+        write(pic, va_arg(ap, pic_value), file, DISPLAY_MODE, OP_WRITE);
+        break;
+      case 's':
+        write(pic, va_arg(ap, pic_value), file, WRITE_MODE, OP_WRITE);
+        break;
+      }
+      break;
+    }
+  }
+ exit:
   xfflush(pic, file);
 }
 

src/main.c

@@ -39,7 +39,7 @@ main(int argc, char *argv[], char **envp)
     status = 0;
   }
   pic_catch {
-    pic_print_backtrace(pic, xstderr);
+    pic_print_error(pic, xstderr);
     status = 1;
   }