Improve read.c

lisp/kernel.gl

@@ -23,4 +23,4 @@
   (princ datum print-char-fun)
   (funcall (or print-char-fun 'write-byte) ?\n))
 
-(princln (apply 'cons '(a b)))
+(princln (list (symbolp 1) '1a '1aa))

src/function.c

@@ -211,7 +211,7 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(void),
     obj->impl.native.no_eval_args = false;
     obj->impl.native.addr.zero = cfunc;
     ReadStream stream;
-    read_stream_init(&stream, lisp_args, args_len);
+    read_stream_init_from_string(&stream, lisp_args, args_len);
     LispVal *args_form = read(&stream);
     if (!args_form) {
         fprintf(stderr, "Builtin function lambda list had a syntax error\n");

src/io.c

@@ -0,0 +1,70 @@
+#include "io.h"
+
+#include "lisp_string.h"
+#include "list.h"
+#include "stack.h"
+
+#include <errno.h>
+#include <stdio.h>
+#include <string.h>
+
+static noreturn void signal_io_error_from_errno(int n) {
+    char *msg = strerror(n);
+    lisp_signal(Qio_error, LIST(make_lisp_string(msg, strlen(msg), true, true),
+                                MAKE_FIXNUM(n)));
+}
+
+static void lisp_fputc(LispVal *ch, FILE *file) {
+    if (NILP(ch)) {
+        if (fflush(file) == EOF) {
+            signal_io_error_from_errno(errno);
+        }
+        return;
+    }
+    CHECK_CHAR(ch);
+    fixnum_t f = XFIXNUM(ch);
+    if (fputc(f, file) == EOF) {
+        signal_io_error_from_errno(errno);
+    }
+}
+
+DEFUN(write_byte, "write-byte", (LispVal * ch), "(ch)", "") {
+    lisp_fputc(ch, stdout);
+    return Qnil;
+}
+
+DEFUN(error_write_byte, "error-write-byte", (LispVal * ch), "(ch)", "") {
+    lisp_fputc(ch, stderr);
+    return Qnil;
+}
+
+static LispVal *lisp_fgetc(LispVal *unread, FILE *file) {
+    if (!NILP(unread)) {
+        CHECK_CHAR(unread);
+        if (ungetc(XFIXNUM(unread), file) == EOF) {
+            signal_io_error_from_errno(errno);
+        }
+        return Qnil;
+    }
+    errno = 0;
+    int res = fgetc(file);
+    if (res == EOF) {
+        if (errno) {
+            signal_io_error_from_errno(errno);
+        }
+        return Qnil;
+    }
+    return MAKE_FIXNUM(res);
+}
+
+DEFUN(read_byte, "read-byte", (LispVal * unread), "(&optional unread)", "") {
+    return lisp_fgetc(unread, stdout);
+}
+
+DEFUN(error_read_byte, "error-read-byte", (LispVal * unread),
+      "(&optional unread)", "") {
+    return lisp_fgetc(unread, stderr);
+}
+
+DEFINE_SYMBOL(io_error, "io-error");
+DEFINE_CONDITION_CLASS(io_error, error);

src/io.h

@@ -0,0 +1,27 @@
+#ifndef INCLUDED_IO_H
+#define INCLUDED_IO_H
+
+#include "base.h"
+#include "lisp_string.h"
+
+static ALWAYS_INLINE void CHECK_CHAR(LispVal *val) {
+    if (!FIXNUMP(val)) {
+        signal_type_error(val, Qchar);
+    }
+    fixnum_t n = XFIXNUM(val);
+    if (n < 0 || n > 255) {
+        signal_type_error(val, Qchar);
+    }
+}
+
+// For now, a print character function takes nil to mean flush
+DECLARE_FUNCTION(write_byte, (LispVal * ch));
+DECLARE_FUNCTION(error_write_byte, (LispVal * ch));
+
+DECLARE_FUNCTION(read_byte, (LispVal * unread));
+DECLARE_FUNCTION(error_read_byte, (LispVal * unread));
+
+DECLARE_SYMBOL(io_error);
+MAKE_CONDITION_CLASS(io_error);
+
+#endif

src/main.c

@@ -1,3 +1,4 @@
+#include "io.h"
 #include "lisp.h"
 #include "read.h"
 
@@ -40,7 +41,7 @@ int main(int argc, const char **argv) {
     push_local_reference_frame();
     StackFrame *toplevel = LISP_STACK_REF();
     ReadStream s;
-    read_stream_init(&s, src, src_len);
+    read_stream_init_from_string(&s, src, src_len);
     LispVal *r;
     push_handler_bind_frame(LIST(Qt), toplevel_error_handler, NULL, NULL);
     volatile bool had_toplevel_error = false;

src/memory.c

@@ -50,6 +50,11 @@ static void ensure_string_stream_space(StringStream *restrict stream,
     }
 }
 
+void string_stream_putc(StringStream *restrict stream, char c) {
+    ensure_string_stream_space(stream, 1);
+    stream->buffer[stream->nchars++] = c;
+}
+
 int string_stream_printf(StringStream *restrict stream,
                          const char *restrict format, ...) {
     va_list args;

src/memory.h

@@ -186,6 +186,10 @@ static inline void string_stream_free(StringStream *restrict stream) {
     lisp_free(stream->buffer);
 }
 
+static inline void string_stream_free_as_cleanup(void *stream) {
+    string_stream_free(stream);
+}
+
 static inline void string_stream_steal(StringStream *restrict stream,
                                        char **restrict out,
                                        size_t *restrict out_length) {
@@ -193,6 +197,7 @@ static inline void string_stream_steal(StringStream *restrict stream,
     *out_length = stream->nchars;
 }
 
+void string_stream_putc(StringStream *restrict stream, char c);
 int string_stream_printf(StringStream *restrict stream,
                          const char *restrict format, ...) FORMAT(2, 3);
 int string_stream_vprintf(StringStream *restrict stream,

src/print.c

@@ -1,5 +1,6 @@
 #include "print.h"
 
+#include "io.h"
 #include "lisp.h"
 // for WHITESPACEP, READ_EOS, and SYMBOL_END_P
 #include "read.h"
@@ -16,29 +17,6 @@ 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) {
-        signal_type_error(ch, Qchar);
-    }
-    fputc(f, file);
-}
-
-DEFUN(write_byte, "write-byte", (LispVal * ch), "(ch)", "") {
-    lisp_fputc(ch, stdout);
-    return Qnil;
-}
-
-DEFUN(error_write_byte, "error-write-byte", (LispVal * ch), "(ch)", "") {
-    lisp_fputc(ch, stderr);
-    return Qnil;
-}
-
 struct PrintOptions {
     bool readable;
     bool circle;

src/print.h

@@ -14,10 +14,6 @@ DECLARE_VARIABLE(print_precision);
 DECLARE_VARIABLE(print_quoted);
 DECLARE_VARIABLE(print_empty_list);
 
-// For now, a print character function takes nil to mean flush
-DECLARE_FUNCTION(write_byte, (LispVal * ch));
-DECLARE_FUNCTION(error_write_byte, (LispVal * ch));
-
 // Pretty print
 DECLARE_FUNCTION(princ, (LispVal * val, LispVal *print_char_fun));
 // Quoted print

src/read.c

@@ -1,5 +1,7 @@
 #include "read.h"
 
+#include "function.h"
+#include "io.h"
 #include "lisp_string.h"
 #include "list.h"
 #include "stack.h"
@@ -13,24 +15,61 @@
 #include <stdnoreturn.h>
 #include <string.h>
 
-void read_stream_init(ReadStream *stream, const char *buffer, size_t length) {
-    stream->buffer = buffer;
-    stream->len = length;
-    stream->off = 0;
+void read_stream_init_from_string(ReadStream *restrict stream,
+                                  const char *buffer, size_t length) {
+    stream->kind = READ_STREAM_STRING;
+    stream->string.buffer = buffer;
+    stream->string.len = length;
+    stream->string.off = 0;
     stream->line = 1;
     stream->col = 0;
     stream->backquote_level = 0;
 }
 
-static ALWAYS_INLINE bool EOSP(const ReadStream *stream) {
-    return stream->off == stream->len;
+void read_stream_init_from_func(ReadStream *restrict stream,
+                                LispVal *read_char_func) {
+    stream->kind = READ_STREAM_FUNC;
+    stream->func.func = read_char_func;
+    stream->func.is_eof = false;
+    stream->line = 1;
+    stream->col = 0;
+    stream->backquote_level = 0;
 }
 
-static int pop_char(ReadStream *stream) {
+static int peek_char(ReadStream *restrict stream);
+static ALWAYS_INLINE bool EOSP(ReadStream *restrict stream) {
+    switch (stream->kind) {
+    case READ_STREAM_STRING:
+        return stream->string.off == stream->string.len;
+    case READ_STREAM_FUNC:
+        peek_char(stream);
+        return stream->func.is_eof;
+    default:
+        abort();
+    }
+}
+
+static int pop_char(ReadStream *restrict stream) {
     if (EOSP(stream)) {
         return READ_EOS;
     }
-    int c = stream->buffer[stream->off++];
+    int c;
+    switch (stream->kind) {
+    case READ_STREAM_STRING:
+        c = stream->string.buffer[stream->string.off++];
+        break;
+    case READ_STREAM_FUNC: {
+        LispVal *lisp_c = CALL0(stream->func.func);
+        if (NILP(lisp_c)) {
+            stream->func.is_eof = true;
+            return READ_EOS;
+        }
+        CHECK_CHAR(lisp_c);
+        c = XFIXNUM(lisp_c);
+    }
+    default:
+        abort();
+    }
     if (c == '\n') {
         ++stream->line;
         stream->col = 0;
@@ -40,18 +79,30 @@ static int pop_char(ReadStream *stream) {
     return c;
 }
 
-static int peek_nth_char(const ReadStream *stream, int n) {
-    if (stream->len - stream->off <= n) {
+static int peek_char(ReadStream *restrict stream) {
+    if (EOSP(stream)) {
         return READ_EOS;
     }
-    return stream->buffer[stream->off + n];
+    switch (stream->kind) {
+    case READ_STREAM_STRING:
+        return stream->string.buffer[stream->string.off];
+    case READ_STREAM_FUNC: {
+        LispVal *lisp_c = CALL0(stream->func.func);
+        if (NILP(lisp_c)) {
+            stream->func.is_eof = true;
+            return READ_EOS;
+        }
+        CHECK_CHAR(lisp_c);
+        int c = XFIXNUM(lisp_c);
+        CALL(stream->func.func, lisp_c); // unget the character
+        return c;
+    }
+    default:
+        abort();
+    }
 }
 
-static int peek_char(const ReadStream *stream) {
-    return peek_nth_char(stream, 0);
-}
-
-static void skip_whitespace(ReadStream *stream) {
+static void skip_whitespace(ReadStream *restrict stream) {
     bool in_comment = false;
     int c;
     while ((c = peek_char(stream)) != READ_EOS
@@ -65,17 +116,15 @@ static void skip_whitespace(ReadStream *stream) {
     }
 }
 
-FORMAT(3, 4)
-static noreturn void read_error(ReadStream *stream, size_t length,
-                                const char *msg, ...) {
+FORMAT(2, 3)
+static noreturn void read_error(ReadStream *restrict stream,
+                                const char *restrict msg, ...) {
     va_list args;
     va_start(args, msg);
     LispVal *lmsg = lisp_vsprintf(msg, args);
     va_end(args);
-    lisp_signal(Qread_error,
-                LIST(MAKE_FIXNUM(stream->line), MAKE_FIXNUM(stream->col), lmsg,
-                     make_lisp_string(stream->buffer + stream->off, length,
-                                      true, true)));
+    lisp_signal(Qread_error, LIST(MAKE_FIXNUM(stream->line),
+                                  MAKE_FIXNUM(stream->col), lmsg));
 }
 
 static ALWAYS_INLINE bool DOT_SYMBOL_P(LispVal *val) {
@@ -86,7 +135,7 @@ static ALWAYS_INLINE bool DOT_SYMBOL_P(LispVal *val) {
     return name->length == 1 && name->data[0] == '.';
 }
 
-LispVal *next_list(ReadStream *stream) {
+LispVal *next_list(ReadStream *restrict stream) {
     pop_char(stream); // the (
     skip_whitespace(stream);
     LispVal *start = Qnil;
@@ -94,20 +143,19 @@ LispVal *next_list(ReadStream *stream) {
     bool dotted = false;
     while (peek_char(stream) != ')') {
         if (dotted) {
-            read_error(stream, 0,
-                       "invalid syntax encountered while reading list");
+            read_error(stream, "invalid syntax encountered while reading list");
         }
         skip_whitespace(stream);
         LispVal *new_val = read(stream);
         if (new_val && DOT_SYMBOL_P(new_val)) {
             if (NILP(start)) {
-                read_error(stream, 1, "list has no car");
+                read_error(stream, "list has no car");
             }
             dotted = true;
             new_val = read(stream);
         }
         if (!new_val) {
-            read_error(stream, 0, "got EOF while reading list");
+            read_error(stream, "got EOF while reading list");
         }
         if (dotted) {
             RPLACD(end, new_val);
@@ -121,12 +169,12 @@ LispVal *next_list(ReadStream *stream) {
         skip_whitespace(stream);
     }
     if (pop_char(stream) == READ_EOS) { // the  )
-        read_error(stream, 0, "got EOF while reading list");
+        read_error(stream, "got EOF while reading list");
     }
     return start;
 }
 
-LispVal *next_vector(ReadStream *stream) {
+LispVal *next_vector(ReadStream *restrict stream) {
     pop_char(stream); // the [
     skip_whitespace(stream);
     LispVal **data = NULL;
@@ -135,7 +183,7 @@ LispVal *next_vector(ReadStream *stream) {
         LispVal *new_val = read(stream);
         if (!new_val) {
             free(data);
-            read_error(stream, 0, "got EOF while reading vector");
+            read_error(stream, "got EOF while reading vector");
         }
         data = lisp_realloc(data, sizeof(LispVal *) * ++length);
         data[length - 1] = new_val;
@@ -143,12 +191,12 @@ LispVal *next_vector(ReadStream *stream) {
     }
     if (pop_char(stream) == READ_EOS) { // the  ]
         free(data);
-        read_error(stream, 0, "got EOF while reading vector");
+        read_error(stream, "got EOF while reading vector");
     }
     return make_vector(data, length, true);
 }
 
-LispVal *next_string(ReadStream *stream) {
+LispVal *next_string(ReadStream *restrict stream) {
     pop_char(stream); // the "
     bool backslash = false;
     char *buffer = lisp_malloc(1);
@@ -158,7 +206,7 @@ LispVal *next_string(ReadStream *stream) {
         int c = pop_char(stream);
         if (c == READ_EOS) {
             free(buffer);
-            read_error(stream, 0, "got EOF while reading string");
+            read_error(stream, "got EOF while reading string");
         } else if (c == '\\' && !backslash) {
             backslash = true;
         } else {
@@ -179,7 +227,7 @@ LispVal *next_string(ReadStream *stream) {
                     break;
                 default:
                     free(buffer);
-                    read_error(stream, 0, "unknown escape sequence");
+                    read_error(stream, "unknown escape sequence");
                 }
             }
             buffer = lisp_realloc(buffer, ++len + 1);
@@ -190,16 +238,16 @@ LispVal *next_string(ReadStream *stream) {
     }
     if (pop_char(stream) == READ_EOS) { // the  "
         free(buffer);
-        read_error(stream, 0, "got EOF while reading string");
+        read_error(stream, "got EOF while reading string");
     }
     return make_lisp_string(buffer, len, true, false);
 }
 
-LispVal *next_char_literal(ReadStream *stream) {
+LispVal *next_char_literal(ReadStream *restrict stream) {
     pop_char(stream); // the ?
     int c = pop_char(stream);
     if (c == READ_EOS) {
-        read_error(stream, 0, "unterminated character literal");
+        read_error(stream, "unterminated character literal");
     } else if (c == '\\') {
         ReadStream save = *stream;
         switch (pop_char(stream)) {
@@ -212,22 +260,28 @@ LispVal *next_char_literal(ReadStream *stream) {
         case 's':
             return MAKE_FIXNUM(' ');
         case READ_EOS:
-            read_error(stream, 0, "unterminated character escape sequence");
+            read_error(stream, "unterminated character escape sequence");
         default:
-            read_error(&save, 0, "unknown escape sequence");
+            read_error(&save, "unknown escape sequence");
         }
     } else {
         return MAKE_FIXNUM(c);
     }
 }
 
-LispVal *next_symbol(ReadStream *stream) {
+LispVal *next_symbol(const char *restrict first, size_t first_size,
+                     ReadStream *restrict stream) {
+    size_t read_from_first = 0;
     bool backslash = false;
     char *name = lisp_malloc(1);
     name[0] = '\0';
     size_t size = 0;
-    while (backslash || !SYMBOL_END_P(peek_char(stream))) {
-        int c = pop_char(stream);
+    while (backslash
+           || !SYMBOL_END_P(read_from_first == first_size
+                                ? peek_char(stream)
+                                : first[read_from_first])) {
+        int c = read_from_first == first_size ? pop_char(stream)
+                                              : first[read_from_first++];
         if (c == '\\' && !backslash) {
             backslash = true;
         } else {
@@ -235,7 +289,7 @@ LispVal *next_symbol(ReadStream *stream) {
                 switch (c) {
                 case READ_EOS:
                     free(name);
-                    read_error(stream, 0, "backslash not escaping anything");
+                    read_error(stream, "backslash not escaping anything");
                 case '\\':
                     // nothing to do
                     break;
@@ -251,7 +305,7 @@ LispVal *next_symbol(ReadStream *stream) {
                 default:
                     if (!SYMBOL_END_P(c)) {
                         free(name);
-                        read_error(stream, 0,
+                        read_error(stream,
                                    "invalid escape sequence in symbol name");
                     }
                 }
@@ -287,56 +341,72 @@ static bool is_base_char(int base, int c) {
     }
 }
 
-static int parse_base(const char *c, size_t left) {
-    if (left >= 2 && *c == '2' && *(c + 1) == '#') {
-        return 2;
-    } else if (left >= 2 && *c == '8' && *(c + 1) == '#') {
-        return 8;
-    } else if (left >= 3 && *c == '1' && *(c + 1) == '0' && *(c + 2) == '#') {
-        return 10;
-    } else if (left >= 3 && *c == '1' && *(c + 1) == '6' && *(c + 2) == '#') {
-        return 16;
-    } else {
+static int parse_base(ReadStream *restrict stream) {
+    int c = peek_char(stream);
+    int base;
+    switch (c) {
+    case '2':
+    case '8':
+        pop_char(stream);
+        base = c - '0';
+        break;
+    case '1':
+        pop_char(stream);
+        c = peek_char(stream);
+        if (c != '0' && c != '6') {
+            return INVALID_BASE;
+        }
+        pop_char(stream);
+        base = 10 + (c - '0');
+        break;
+    default:
         return INVALID_BASE;
     }
+    if (peek_char(stream) != '#') {
+        return INVALID_BASE;
+    }
+    pop_char(stream);
+    return base;
 }
 
-LispVal *next_number_or_symbol(ReadStream *stream, int base) {
-    ReadStream save = *stream;
+LispVal *next_number_or_symbol(ReadStream *restrict stream, int base) {
     bool has_decimal = false;
-    size_t number_start = stream->off;
+    StringStream ss;
+    string_stream_init(&ss);
+    StackFrame *stack_ref = LISP_STACK_REF();
+    push_unwind_protect_frame(string_stream_free_as_cleanup, &ss, NULL);
+    size_t number_start = 0;
     size_t exp_start = 0;
     bool had_number = false;
     bool negative = false;
     int c;
     while (!SYMBOL_END_P(peek_char(stream))) {
         c = pop_char(stream);
+        string_stream_putc(&ss, c);
         if (c == '#') {
             if (base != ANY_BASE) {
                 goto change_to_symbol;
             }
-            base = parse_base(&stream->buffer[number_start],
-                              stream->len - number_start);
+            base = parse_base(stream);
             if (base == INVALID_BASE) {
                 goto change_to_symbol;
             }
             had_number = false;
-            number_start = stream->off;
+            number_start = ss.nchars;
         } else if (c == '.') {
             if (base != ANY_BASE || has_decimal || exp_start) {
                 goto change_to_symbol;
             }
             has_decimal = true;
         } else if (c == '-' || c == '+') {
-            if (stream->off - 1 != number_start
-                && stream->off - 1 != exp_start) {
+            if (ss.nchars - 1 != number_start && ss.nchars - 1 != exp_start) {
                 goto change_to_symbol;
             }
             // for inf
-            if (c == '-' && stream->off - 1 == number_start) {
+            if (c == '-' && ss.nchars - 1 == number_start) {
                 negative = true;
             }
-        } else if (exp_start == stream->off - 1 && base == ANY_BASE
+        } else if (exp_start == ss.nchars - 1 && base == ANY_BASE
                    && (c == 'n' || c == 'N')) {
             // attempt to read "nan" or fallback to symbol
             if (tolower(pop_char(stream)) != 'a'
@@ -344,10 +414,10 @@ LispVal *next_number_or_symbol(ReadStream *stream, int base) {
                 goto change_to_symbol;
             }
             if (SYMBOL_END_P(peek_char(stream))) {
-                return LISP_NAN;
+                return UNWIND_AND_RETURN(stack_ref, LISP_NAN);
             }
             goto change_to_symbol;
-        } else if (exp_start == stream->off - 1 && base == ANY_BASE
+        } else if (exp_start == ss.nchars - 1 && base == ANY_BASE
                    && (c == 'i' || c == 'I')) {
             // same for "inf"
             if (tolower(pop_char(stream)) != 'n'
@@ -355,13 +425,14 @@ LispVal *next_number_or_symbol(ReadStream *stream, int base) {
                 goto change_to_symbol;
             }
             if (SYMBOL_END_P(peek_char(stream))) {
-                return negative ? LISP_NEG_INF : LISP_POS_INF;
+                return UNWIND_AND_RETURN(stack_ref, negative ? LISP_NEG_INF
+                                                             : LISP_POS_INF);
             }
             goto change_to_symbol;
         } else if (!is_base_char(base, c)) {
             if ((c == 'e' || c == 'E') && !exp_start && base == ANY_BASE
                 && had_number) {
-                exp_start = stream->off;
+                exp_start = ss.nchars;
             } else {
                 goto change_to_symbol;
             }
@@ -372,41 +443,41 @@ LispVal *next_number_or_symbol(ReadStream *stream, int base) {
     if (!had_number) {
         goto change_to_symbol;
     }
-    size_t len = stream->off - number_start;
+    size_t len = ss.nchars - number_start;
     if (has_decimal || exp_start) {
         // float
         // ceil(# bytes in size_t / 3)
         // This works because log10(2^n) is O(n) for k=3
         size_t size_t_len = ((sizeof(size_t) * 8) / 3) + 1;
         char fmt_buf[3 + size_t_len + 1];
-        if (exp_start == stream->off) {
+        if (exp_start == ss.nchars) {
             goto change_to_symbol;
         }
         snprintf(fmt_buf, sizeof(fmt_buf), "%%%zu" LISP_FLOAT_SCANF, len);
         lisp_float_t value;
-        sscanf(&stream->buffer[number_start], fmt_buf, &value);
-        return MAKE_LISP_FLOAT(value);
+        sscanf(&ss.buffer[number_start], fmt_buf, &value);
+        return UNWIND_AND_RETURN(stack_ref, MAKE_LISP_FLOAT(value));
     } else {
         // integer
         // TODO handle large numbers
         size_t fixnum_len = ((sizeof(fixnum_t) * 8) / 3) + 1;
         char read_buf[fixnum_len + 1];
         if (len > fixnum_len) {
-            read_error(stream, 0, "numeric literal too large");
+            read_error(stream, "numeric literal too large");
         }
-        memcpy(read_buf, &stream->buffer[number_start], len);
+        memcpy(read_buf, &ss.buffer[number_start], len);
         read_buf[len] = '\0';
         intmax_t value =
             strtoimax(read_buf, NULL, base == ANY_BASE ? 10 : base);
         if (value < MOST_NEGATIVE_FIXNUM || value > MOST_POSITIVE_FIXNUM) {
-            read_error(stream, 0, "numeric literal too large");
+            read_error(stream, "numeric literal too large");
         }
-        return MAKE_FIXNUM(value);
+        return UNWIND_AND_RETURN(stack_ref, MAKE_FIXNUM(value));
     }
     abort();
 change_to_symbol:
-    *stream = save;
-    return next_symbol(stream);
+    return UNWIND_AND_RETURN(stack_ref,
+                             next_symbol(ss.buffer, ss.nchars, stream));
 }
 
 LispVal *read(ReadStream *stream) {
@@ -418,12 +489,12 @@ LispVal *read(ReadStream *stream) {
     switch (next) {
     case ')':
     case ']':
-        read_error(stream, 1, "extra closing character");
+        read_error(stream, "extra closing character");
     case '\'': {
         pop_char(stream);
         skip_whitespace(stream);
         if (EOSP(stream)) {
-            read_error(stream, 0, "quote not quoting anything");
+            read_error(stream, "quote not quoting anything");
         }
         return LIST(Qquote, read(stream));
     }
@@ -432,7 +503,7 @@ LispVal *read(ReadStream *stream) {
         pop_char(stream);
         skip_whitespace(stream);
         if (EOSP(stream)) {
-            read_error(stream, 0, "backquote not quoting anything");
+            read_error(stream, "backquote not quoting anything");
         }
         LispVal *to_return = LIST(Qbackquote, read(stream));
         --stream->backquote_level;
@@ -440,7 +511,7 @@ LispVal *read(ReadStream *stream) {
     }
     case ',': {
         if (!stream->backquote_level) {
-            read_error(stream, 0, "comma outside of a backquote");
+            read_error(stream, "comma outside of a backquote");
         }
         pop_char(stream);
         LispVal *car;
@@ -451,7 +522,7 @@ LispVal *read(ReadStream *stream) {
         }
         skip_whitespace(stream);
         if (EOSP(stream)) {
-            read_error(stream, 0, "comma not splicing anything");
+            read_error(stream, "comma not splicing anything");
         }
         return LIST(car, read(stream));
     } break;
@@ -478,7 +549,7 @@ LispVal *read(ReadStream *stream) {
     case '9':
         return next_number_or_symbol(stream, ANY_BASE);
     default:
-        return next_symbol(stream);
+        return next_symbol(NULL, 0, stream);
     }
 }
 

src/read.h

@@ -17,17 +17,33 @@ static ALWAYS_INLINE bool SYMBOL_END_P(int c) {
            || c == '`' || c == ';';
 }
 
+enum ReadStreamImpl {
+    READ_STREAM_STRING,
+    READ_STREAM_FUNC,
+};
+
 typedef struct {
-    const char *buffer;
-    size_t len;
-    size_t off;
+    enum ReadStreamImpl kind;
+    union {
+        struct {
+            const char *buffer;
+            size_t len;
+            size_t off;
+        } string;
+        struct {
+            LispVal *func;
+            bool is_eof;
+        } func;
+    };
 
     size_t line;
     size_t col;
     size_t backquote_level;
 } ReadStream;
 
-void read_stream_init(ReadStream *stream, const char *buffer, size_t length);
+void read_stream_init_from_string(ReadStream *stream, const char *buffer,
+                                  size_t length);
+void read_stream_init_from_func(ReadStream *stream, LispVal *read_char_func);
 
 // NULL on eof
 LispVal *read(ReadStream *stream);