Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Finish printing

Browse Source
This commit is contained in:
Zander671
2026-08-13 14:10:29 -07:00
parent 20aed63851
commit 17c11d90ea
5 changed files with 177 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lisp/kernel.gl
+4 -1
View File
@@ -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)
src/print.c
+157
View File
@@ -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();
src/print.h
+1
View File
@@ -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));
src/read.c
+3 -12
View File
@@ -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;
src/read.h
+12
View File
@@ -5,6 +5,18 @@
#include <stddef.h>
#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;