Finish printing

src/print.c

@@ -1,6 +1,8 @@
 #include "print.h"
 
 #include "lisp.h"
+// for WHITESPACEP, READ_EOS, and SYMBOL_END_P
+#include "read.h"
 
 #include <limits.h>
 #include <string.h>
@@ -11,6 +13,7 @@ DEFVAR(print_level, "print-level", "", Qnil);
 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);
 
 DEFUN(write_byte, "write-byte", (LispVal * ch), "(ch)", "") {
     if (NILP(ch)) {
@@ -34,6 +37,7 @@ struct PrintOptions {
     fixnum_t base;
     bool base_upper;
     fixnum_t precision;
+    bool quoted;
 };
 
 struct PrintContext {
@@ -71,6 +75,7 @@ static void init_print_options(struct PrintOptions *opts, bool readable) {
     } else if (opts->precision > LISP_FLOAT_MAX_PRECISION) {
         opts->precision = LISP_FLOAT_MAX_PRECISION;
     }
+    opts->quoted = !NILP(Vprint_quoted);
 }
 
 static void init_print_context(struct PrintContext *restrict pc, bool readable,
@@ -97,6 +102,8 @@ static void print_buffer(struct PrintContext *restrict pc,
 }
 #define PRINT_STATIC_BUFFER(pc, buf) print_buffer(pc, buf, sizeof(buf) - 1)
 
+static void print_driver(struct PrintContext *restrict pc, LispVal *val);
+
 static void print_fixnum_base(struct PrintContext *restrict pc, LispVal *val) {
     switch (pc->opts.base) {
     case 2:
@@ -197,6 +204,137 @@ static void print_float(struct PrintContext *restrict pc, LispVal *val) {
     }
 }
 
+static void print_cons(struct PrintContext *restrict pc, LispVal *val) {
+    if (pc->opts.quoted && EQ(XCAR(val), Qquote) && list_length_eq(val, 2)) {
+        print_char(pc, '\'');
+        print_driver(pc, SECOND(val));
+        return;
+    }
+    print_char(pc, '(');
+    bool first = true;
+    DOTAILS(rest, val) {
+        if (!first) {
+            print_char(pc, ' ');
+        }
+        first = false;
+        print_driver(pc, XCAR(rest));
+        if (!LISTP(XCDR(rest))) {
+            PRINT_STATIC_BUFFER(pc, " . ");
+            print_driver(pc, XCDR(rest));
+            break;
+        }
+    }
+    print_char(pc, ')');
+}
+
+static void print_readable_string(struct PrintContext *restrict pc,
+                                  LispVal *val) {
+    LispString *s = val;
+    print_char(pc, '"');
+    for (size_t i = 0; i < s->length; ++i) {
+        char c = s->data[i];
+        switch (c) {
+        case '"':
+            PRINT_STATIC_BUFFER(pc, "\\\"");
+            break;
+        case '\n':
+            PRINT_STATIC_BUFFER(pc, "\\n");
+            break;
+        case '\t':
+            PRINT_STATIC_BUFFER(pc, "\\t");
+        case '\0':
+            PRINT_STATIC_BUFFER(pc, "\\0");
+            break;
+        default:
+            print_char(pc, c);
+            break;
+        }
+    }
+    print_char(pc, '"');
+}
+
+static void print_pretty_string(struct PrintContext *restrict pc,
+                                LispVal *val) {
+    LispString *s = val;
+    print_buffer(pc, s->data, s->length);
+}
+
+static void print_readable_symbol(struct PrintContext *restrict pc,
+                                  LispVal *val) {
+    LispSymbol *sym = val;
+    assert(STRINGP(sym->name));
+    LispString *n = sym->name;
+    for (size_t i = 0; i < n->length; ++i) {
+        char c = n->data[i];
+        if (c == '\n') {
+            PRINT_STATIC_BUFFER(pc, "\\n");
+        } else if (c == '\t') {
+            PRINT_STATIC_BUFFER(pc, "\\t");
+        } else if (c == '\0') {
+            PRINT_STATIC_BUFFER(pc, "\\0");
+        } else if (c == '\\' || SYMBOL_END_P(c)) {
+            print_char(pc, '\\');
+            print_char(pc, c);
+        } else {
+            print_char(pc, c);
+        }
+    }
+}
+
+static void print_pretty_symbol(struct PrintContext *restrict pc,
+                                LispVal *val) {
+    LispSymbol *sym = val;
+    assert(STRINGP(sym->name));
+    print_pretty_string(pc, sym->name);
+}
+
+static void print_vector(struct PrintContext *restrict pc, LispVal *val) {
+    LispVector *vec = val;
+    print_char(pc, '[');
+    bool first = true;
+    for (size_t i = 0; i < vec->length; ++i) {
+        if (!first) {
+            print_char(pc, ' ');
+        }
+        first = false;
+        print_driver(pc, vec->data[i]);
+    }
+    print_char(pc, ']');
+}
+
+static void print_hash_table(struct PrintContext *restrict pc, LispVal *val) {
+    LispHashTable *ht = val;
+    PRINT_STATIC_BUFFER(pc, "<hash-table count=");
+    // large enough for 32 or 64 bit word size
+    char buffer[32];
+    int written = snprintf(buffer, sizeof(buffer), "%zu", ht->count);
+    assert(written < sizeof(buffer));
+    print_buffer(pc, buffer, written);
+    print_char(pc, '>');
+}
+
+static void print_function(struct PrintContext *restrict pc, LispVal *val) {
+    LispFunction *f = val;
+    print_char(pc, '<');
+    switch (f->type) {
+    case FUNCTION_NATIVE:
+        PRINT_STATIC_BUFFER(pc, "native-function");
+        break;
+    case FUNCTION_INTERP:
+        PRINT_STATIC_BUFFER(pc, "interp-function");
+        break;
+    default:
+        abort();
+    }
+    print_char(pc, ' ');
+    // large enough for 32 or 64 bit word size
+    char buffer[32];
+    int written = snprintf(buffer, sizeof(buffer), "0x%jx", (uintmax_t) &f);
+    assert(written < sizeof(buffer));
+    print_buffer(pc, buffer, written);
+    print_char(pc, '>');
+}
+
 static void print_driver(struct PrintContext *restrict pc, LispVal *val) {
     switch (TYPE_OF(val)) {
     case TYPE_FIXNUM:
@@ -206,11 +344,30 @@ static void print_driver(struct PrintContext *restrict pc, LispVal *val) {
         print_float(pc, val);
         break;
     case TYPE_CONS:
+        print_cons(pc, val);
+        break;
     case TYPE_STRING:
+        if (pc->opts.readable) {
+            print_readable_string(pc, val);
+        } else {
+            print_pretty_string(pc, val);
+        }
+        break;
     case TYPE_SYMBOL:
+        if (pc->opts.readable) {
+            print_readable_symbol(pc, val);
+        } else {
+            print_pretty_symbol(pc, val);
+        }
+        break;
     case TYPE_VECTOR:
+        print_vector(pc, val);
+        break;
     case TYPE_HASH_TABLE:
+        print_hash_table(pc, val);
+        break;
     case TYPE_FUNCTION:
+        print_function(pc, val);
         break;
     default:
         abort();