From 17c11d90ea87af7ac459c85ea420a99009cfc95e Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Thu, 13 Aug 2026 14:10:29 -0700 Subject: [PATCH] Finish printing --- lisp/kernel.gl | 5 +- src/print.c | 157 +++++++++++++++++++++++++++++++++++++++++++++++++ src/print.h | 1 + src/read.c | 15 +---- src/read.h | 12 ++++ 5 files changed, 177 insertions(+), 13 deletions(-) diff --git a/lisp/kernel.gl b/lisp/kernel.gl index 4893017..c19bdc0 100644 --- a/lisp/kernel.gl +++ b/lisp/kernel.gl @@ -1,4 +1,7 @@ ;; -*- mode: lisp-data -*- -(prin1 1.0e2) +(let ((print-quoted nil)) + (prin1 '(quote a)) + (write-byte ?\n)) +(prin1 '(quote a)) (write-byte ?\n) diff --git a/src/print.c b/src/print.c index 6e37ffa..fe15278 100644 --- a/src/print.c +++ b/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 #include @@ -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, "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(); diff --git a/src/print.h b/src/print.h index 13007f1..85fc8ff 100644 --- a/src/print.h +++ b/src/print.h @@ -11,6 +11,7 @@ DECLARE_VARIABLE(print_level); DECLARE_VARIABLE(print_base); DECLARE_VARIABLE(print_base_upper); DECLARE_VARIABLE(print_precision); +DECLARE_VARIABLE(print_quoted); // For now, a print character function takes nil to mean flush DECLARE_FUNCTION(write_byte, (LispVal * ch)); diff --git a/src/read.c b/src/read.c index 88774f7..c14eaca 100644 --- a/src/read.c +++ b/src/read.c @@ -21,8 +21,6 @@ void read_stream_init(ReadStream *stream, const char *buffer, size_t length) { stream->backquote_level = 0; } -#define READ_EOS -1 - static ALWAYS_INLINE bool EOSP(const ReadStream *stream) { return stream->off == stream->len; } @@ -52,10 +50,6 @@ static int peek_char(const ReadStream *stream) { return peek_nth_char(stream, 0); } -static ALWAYS_INLINE bool WHITESPACEP(int c) { - return c == ' ' || c == '\t' || c == '\n'; -} - static void skip_whitespace(ReadStream *stream) { bool in_comment = false; int c; @@ -226,12 +220,6 @@ LispVal *next_char_literal(ReadStream *stream) { } } -static ALWAYS_INLINE bool SYMBOL_END_P(int c) { - return WHITESPACEP(c) || c == READ_EOS || c == '(' || c == ')' || c == '[' - || c == ']' || c == '\'' || c == '\"' || c == ',' || c == '@' - || c == '`' || c == ';'; -} - LispVal *next_symbol(ReadStream *stream) { bool backslash = false; char *name = lisp_malloc(1); @@ -247,6 +235,9 @@ LispVal *next_symbol(ReadStream *stream) { case READ_EOS: free(name); read_error(stream, 0, "backslash not escaping anything"); + case '\\': + // nothing to do + break; case 'n': c = '\n'; break; diff --git a/src/read.h b/src/read.h index 0f47858..3ffc75c 100644 --- a/src/read.h +++ b/src/read.h @@ -5,6 +5,18 @@ #include +#define READ_EOS -1 + +static ALWAYS_INLINE bool WHITESPACEP(int c) { + return c == ' ' || c == '\t' || c == '\n'; +} + +static ALWAYS_INLINE bool SYMBOL_END_P(int c) { + return WHITESPACEP(c) || c == READ_EOS || c == '(' || c == ')' || c == '[' + || c == ']' || c == '\'' || c == '\"' || c == ',' || c == '@' + || c == '`' || c == ';'; +} + typedef struct { const char *buffer; size_t len;