More exception stuff

src/print.c

@@ -14,16 +14,17 @@ DEFVAR(print_base, "print-base", "", MAKE_FIXNUM(10));
 DEFVAR(print_base_upper, "print-base-upper", "", Qt);
 DEFVAR(print_precision, "print-precision", "", MAKE_FIXNUM(6));
 DEFVAR(print_quoted, "print-quoted", "", Qt);
+DEFVAR(print_empty_list, "print-empty-list", "", Qnil);
 
 static void lisp_fputc(LispVal *ch, FILE *file) {
     if (NILP(ch)) {
         fflush(file);
+        return;
     }
     CHECK_TYPE(ch, TYPE_FIXNUM);
     fixnum_t f = XFIXNUM(ch);
     if (f < 0 || f > 255) {
-        // TODO error
-        abort();
+        signal_type_error(ch, Qchar);
     }
     fputc(f, file);
 }
@@ -47,6 +48,7 @@ struct PrintOptions {
     bool base_upper;
     fixnum_t precision;
     bool quoted;
+    bool empty_list;
 };
 
 struct PrintContext {
@@ -56,6 +58,20 @@ struct PrintContext {
     LispVal *length_stack;
 };
 
+static void check_print_base(fixnum_t base) {
+    switch (base) {
+    case 2:
+    case 8:
+    case 10:
+    case 16:
+        break;
+    default:
+        lisp_signal(
+            Qprint_error,
+            LIST(lisp_sprintf("Invalid base: %" LISP_FIXNUM_PRINTF(d), base)));
+    }
+}
+
 static void init_print_options(struct PrintOptions *opts, bool readable) {
     opts->readable = readable;
     opts->circle = !NILP(Vprint_circular);
@@ -73,9 +89,7 @@ static void init_print_options(struct PrintOptions *opts, bool readable) {
     }
     CHECK_TYPE(Vprint_base, TYPE_FIXNUM);
     opts->base = XFIXNUM(Vprint_base);
-    if (opts->base < 2 || opts->base > 16) {
-        opts->base = 10;
-    }
+    check_print_base(opts->base);
     opts->base_upper = !NILP(Vprint_base_upper);
     CHECK_TYPE(Vprint_precision, TYPE_FIXNUM);
     opts->precision = XFIXNUM(Vprint_precision);
@@ -85,6 +99,7 @@ static void init_print_options(struct PrintOptions *opts, bool readable) {
         opts->precision = LISP_FLOAT_MAX_PRECISION;
     }
     opts->quoted = !NILP(Vprint_quoted);
+    opts->empty_list = !NILP(Vprint_empty_list);
 }
 
 static void init_print_context(struct PrintContext *restrict pc, bool readable,
@@ -130,7 +145,6 @@ static void print_fixnum_base(struct PrintContext *restrict pc, LispVal *val) {
         print_char(pc, '6');
         break;
     default:
-        // TODO error
         abort();
     }
     print_char(pc, '#');
@@ -139,7 +153,7 @@ static void print_fixnum_base(struct PrintContext *restrict pc, LispVal *val) {
 static void print_fixnum(struct PrintContext *restrict pc, LispVal *val) {
     fixnum_t fn = XFIXNUM(val);
     if (fn == 0) {
-        Ffuncall(pc->print_char_fun, MAKE_FIXNUM('0'));
+        CALL(pc->print_char_fun, MAKE_FIXNUM('0'));
     } else {
         if (pc->opts.base != 10 && pc->opts.readable) {
             print_fixnum_base(pc, val);
@@ -270,6 +284,10 @@ static void print_pretty_string(struct PrintContext *restrict pc,
 
 static void print_readable_symbol(struct PrintContext *restrict pc,
                                   LispVal *val) {
+    if (NILP(val) && pc->opts.empty_list) {
+        print_buffer(pc, "()", 2);
+        return;
+    }
     LispSymbol *sym = val;
     assert(STRINGP(sym->name));
     LispString *n = sym->name;
@@ -292,6 +310,10 @@ static void print_readable_symbol(struct PrintContext *restrict pc,
 
 static void print_pretty_symbol(struct PrintContext *restrict pc,
                                 LispVal *val) {
+    if (NILP(val) && pc->opts.empty_list) {
+        print_buffer(pc, "()", 2);
+        return;
+    }
     LispSymbol *sym = val;
     assert(STRINGP(sym->name));
     print_pretty_string(pc, sym->name);
@@ -405,13 +427,12 @@ DEFUN(print_condition, "print-condition",
       (LispVal * name, LispVal *data, LispVal *print_char_fun),
       "(name data &optional print-char-fun)", "") {
     if (NILP(Fcondition_class_p(name))) {
-        // TODO type error
-        abort();
+        signal_type_error(name, Qcondition_class);
     }
     LispVal *printer = Fcondition_printer(name);
     if (NILP(printer)) {
         // default format
-        Fprinc(CONS(name, data), print_char_fun);
+        Fprin1(CONS(name, data), print_char_fun);
     } else {
         // custom format
         CALL(printer, data, print_char_fun);
@@ -419,6 +440,9 @@ DEFUN(print_condition, "print-condition",
     return Qnil;
 }
 
+DEFINE_SYMBOL(print_error, "print-error");
+DEFINE_CONDITION_CLASS(print_error, error);
+
 void debug_print(FILE *file, LispVal *obj) {
     switch (TYPE_OF(obj)) {
     case TYPE_FIXNUM: