Finish printing

Makefile

@@ -17,7 +17,7 @@ CC=gcc
 CFLAGS=$(DEBUG_CFLAGS) $(LLVM_SAN_FLAGS) -std=c11 -Wall -Wpedantic $\
        -D_POSIX_C_SOURCE=200112L
 LD=gcc
-LDFLAGS=$(LLVM_SAN_FLAGS)
+LDFLAGS=-lm $(LLVM_SAN_FLAGS)
 
 SRCS:=$(wildcard src/*.c)
 OBJS:=$(SRCS:src/%.c=bin/%.o)

lisp/kernel.gl

@@ -1,10 +1,7 @@
 ;; -*- mode: lisp-data -*-
 
-(fset 'test (lambda () (print print-circular)))
-
-(print print-circular)
-
-(let ((print-circular nil))
-  (test))
-
-(print print-circular)
+(let ((print-quoted nil))
+  (prin1 '(quote a))
+  (write-byte ?\n))
+(prin1 '(quote a))
+(write-byte ?\n)

src/base.h

@@ -6,6 +6,7 @@
 #include "memory.h"
 
 #include <assert.h>
+#include <inttypes.h>
 #include <stdnoreturn.h>
 
 // ###################
@@ -17,12 +18,21 @@ typedef void LispVal;
 // # Fixnum and float stuff #
 // ##########################
 typedef intptr_t fixnum_t;
+#define LISP_FIXNUM_PRINTF(code) PRI##code##PTR
 #if LISP_WORD_BITS == 32
-#    define LISP_FLOAT_SCANF "f"
+#    define LISP_FLOAT_SCANF  "f"
+#    define LISP_FLOAT_PRINTF "f"
 typedef lisp_float32_t lisp_float_t;
+#    define LISP_FLOAT_NAN           LISP_FLOAT32_NAN()
+#    define LISP_FLOAT_INF           LISP_FLOAT32_INF()
+#    define LISP_FLOAT_MAX_PRECISION FLOAT32_MAX_PRECISION
 #else
-#    define LISP_FLOAT_SCANF "lf"
+#    define LISP_FLOAT_SCANF         "lf"
+#    define LISP_FLOAT_PRINTF        "f"
 typedef lisp_float64_t lisp_float_t;
+#    define LISP_FLOAT_NAN           LISP_FLOAT64_NAN()
+#    define LISP_FLOAT_INF           LISP_FLOAT64_INF()
+#    define LISP_FLOAT_MAX_PRECISION FLOAT64_MAX_PRECISION
 #endif
 
 #define MOST_POSITIVE_FIXNUM ((intptr_t) ((INTPTR_MAX & ~(intptr_t) 3) >> 2))
@@ -73,6 +83,10 @@ static ALWAYS_INLINE LispVal *MAKE_LISP_FLOAT(lisp_float_t flt) {
     return (LispVal *) ((bits & ~(uintptr_t) 3) | LISP_FLOAT_TAG);
 }
 
+#define LISP_NAN     MAKE_LISP_FLOAT(LISP_FLOAT_NAN)
+#define LISP_POS_INF MAKE_LISP_FLOAT(LISP_FLOAT_INF)
+#define LISP_NEG_INF MAKE_LISP_FLOAT(-LISP_FLOAT_INF)
+
 // ###############
 // # Other types #
 // ###############

src/lisp.c

@@ -4,6 +4,8 @@
 #include "init_globals.h"
 #include "lisp_string.h"
 
+#include <locale.h>
+
 LispVal *obarray;
 
 static void construct_manual_symbols(void) {
@@ -131,24 +133,47 @@ DEFSPECIAL(progn, "progn", (LispVal * forms), "(&rest forms)", "") {
     return rval;
 }
 
+DEFSPECIAL(setq, "setq", (LispVal * bindings), "(&rest bindings)", "") {
+    size_t nbindings = list_length(bindings);
+    if (nbindings < 2 || (nbindings & 1) != 0) {
+        // TODO error
+        abort();
+    }
+    LispVal *value = Qnil;
+    for (LispVal *rest = bindings; !NILP(bindings);
+         bindings = XCDR(XCDR(bindings))) {
+        LispVal *name = FIRST(rest);
+        value = Feval(SECOND(rest), Vlexical_environment);
+        set_lexical_variable(name, value);
+    }
+    return value;
+}
+
 DEFSPECIAL(let, "let", (LispVal * bindings, LispVal *body),
            "(bindings &rest body)", "") {
     CHECK_LISTP(bindings);
     StackFrame *stack_ref = LISP_STACK_REF();
-    LispVal *lexenv = Vlexical_environment;
     DOLIST(binding, bindings) {
-        if (SYMBOLP(binding)) {
-            lexenv = CONS(binding, CONS(Qnil, lexenv));
-        } else if (CONSP(binding) && list_length_eq(binding, 2)) {
-            lexenv = CONS(
-                FIRST(binding),
-                CONS(Feval(SECOND(binding), Vlexical_environment), lexenv));
-        } else {
+        if (CONSP(binding) && list_length_eq(binding, 2)) {
+            if (!SYMBOLP(XCAR(binding))) {
+                // TODO better error
+                abort();
+            }
+            RPLACA(XCDR(binding), Feval(SECOND(binding), Vlexical_environment));
+        } else if (!SYMBOLP(binding)) {
             // TODO better error
             abort();
         }
     }
-    push_dynamic_binding(Qlexical_environment, lexenv);
+    push_copy_lexenv();
+    DOLIST(binding, bindings) {
+        // we already checked that all bindings are well formed
+        if (SYMBOLP(binding)) {
+            new_lexical_variable(binding, Qnil);
+        } else {
+            new_lexical_variable(FIRST(binding), SECOND(binding));
+        }
+    }
     return UNWIND_AND_RETURN(stack_ref, Fprogn(body));
 }
 

src/lisp.h

@@ -17,6 +17,7 @@ void lisp_shutdown(void);
 
 DECLARE_FUNCTION(eval, (LispVal * form, LispVal *lexenv));
 DECLARE_FUNCTION(progn, (LispVal * forms));
+DECLARE_FUNCTION(setq, (LispVal * bindings));
 DECLARE_FUNCTION(let, (LispVal * bindings, LispVal *body));
 DECLARE_FUNCTION(if, (LispVal * cond, LispVal *then, LispVal *otherwise));
 DECLARE_FUNCTION(and, (LispVal * forms));

src/memory.h

@@ -2,6 +2,7 @@
 #define INCLUDED_MEMORY_H
 
 #include <float.h>
+#include <math.h>
 #include <stdarg.h>
 #include <stdbool.h>
 #include <stdint.h>
@@ -10,7 +11,7 @@
 
 // Geneal macros
 #ifndef __has_attribute
-#    define __has_attribute(attr) 0
+#    define __has_attribute(x) 0
 #endif
 
 #if __has_attribute(always_inline) && defined(_NDEBUG)
@@ -50,11 +51,13 @@ static ALWAYS_INLINE bool LITTLE_ENDIAN_P(void) {
 #endif
 // Check if we support this system's floating point implementation
 #if FLT_RADIX != 2 || FLT_MANT_DIG != 24 || DBL_MANT_DIG != 53 \
-    || FLT_MAX_EXP != 128 || DBL_MAX_EXP != 1024
+    || FLT_MAX_EXP != 128 || DBL_MAX_EXP != 1024 || !defined(INFINITY)
 #    error "Floating point implementation not supported."
 #endif
 typedef float lisp_float32_t;
 typedef double lisp_float64_t;
+#define FLOAT32_MAX_PRECISION 6
+#define FLOAT64_MAX_PRECISION 15
 
 static ALWAYS_INLINE uint32_t FLOAT32_TO_INT_BITS(lisp_float32_t flt) {
     union {
@@ -98,6 +101,22 @@ static ALWAYS_INLINE lisp_float64_t INT_TO_FLOAT64_BITS(uint64_t i) {
         uint32_t: INT_TO_FLOAT32_BITS(i), \
         uint64_t: INT_TO_FLOAT64_BITS(i))
 
+static ALWAYS_INLINE lisp_float32_t LISP_FLOAT32_NAN(void) {
+    return INT_TO_FLOAT32_BITS(~(uint32_t) 0);
+}
+
+static ALWAYS_INLINE lisp_float32_t LISP_FLOAT32_INF(void) {
+    return INFINITY;
+}
+
+static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_NAN(void) {
+    return INT_TO_FLOAT64_BITS(~(uint64_t) 0);
+}
+
+static ALWAYS_INLINE lisp_float64_t LISP_FLOAT64_INF(void) {
+    return INFINITY;
+}
+
 // Allocator
 void *lisp_realloc(void *oldptr, size_t size);
 void *lisp_malloc(size_t size);
@@ -130,6 +149,25 @@ static ALWAYS_INLINE void add_timespecs(const struct timespec *t1,
     out->tv_nsec = nsec;
 }
 
+static ALWAYS_INLINE size_t signed_number_length(intmax_t n) {
+    if (!n) {
+        return 1;
+    }
+    size_t sign_part = 0;
+    if (n < 0) {
+        n = -n;
+        sign_part = 1;
+    }
+    return sign_part + floor(log10(n)) + 1;
+}
+
+static ALWAYS_INLINE size_t unsigned_number_length(uintmax_t n) {
+    if (!n) {
+        return 1;
+    }
+    return floor(log10(n)) + 1;
+}
+
 typedef struct {
     // this is actually size + 1 bytes for the null byte
     char *buffer;

src/print.c

@@ -1,47 +1,393 @@
 #include "print.h"
 
 #include "lisp.h"
+// for WHITESPACEP, READ_EOS, and SYMBOL_END_P
+#include "read.h"
+
+#include <limits.h>
+#include <string.h>
 
 DEFVAR(print_circular, "print-circular", "", Qt);
 DEFVAR(print_length, "print-length", "", MAKE_FIXNUM(100));
 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);
 
-struct PrintContext {
+DEFUN(write_byte, "write-byte", (LispVal * ch), "(ch)", "") {
+    if (NILP(ch)) {
+        fflush(stdout);
+    }
+    CHECK_TYPE(ch, TYPE_FIXNUM);
+    fixnum_t f = XFIXNUM(ch);
+    if (f < 0 || f > 255) {
+        // TODO error
+        abort();
+    }
+    fputc(f, stdout);
+    return Qnil;
+}
+
+struct PrintOptions {
+    bool readable;
     bool circle;
-    bool length;
+    fixnum_t length;
+    fixnum_t level;
+    fixnum_t base;
+    bool base_upper;
+    fixnum_t precision;
+    bool quoted;
 };
 
-static void init_print_context(struct PrintContext *restrict pc) {
-    pc->circle = true;
-    pc->length = 80;
+struct PrintContext {
+    struct PrintOptions opts;
+    LispVal *print_char_fun;
+    LispHashTable *seen_objects;
+    LispVal *length_stack;
+};
+
+static void init_print_options(struct PrintOptions *opts, bool readable) {
+    opts->readable = readable;
+    opts->circle = !NILP(Vprint_circular);
+    if (NILP(Vprint_length)) {
+        opts->length = SIZE_MAX;
+    } else {
+        CHECK_TYPE(Vprint_length, TYPE_FIXNUM);
+        opts->length = XFIXNUM(Vprint_length);
+    }
+    if (NILP(Vprint_level)) {
+        opts->level = SIZE_MAX;
+    } else {
+        CHECK_TYPE(Vprint_level, TYPE_FIXNUM);
+        opts->level = XFIXNUM(Vprint_level);
+    }
+    CHECK_TYPE(Vprint_base, TYPE_FIXNUM);
+    opts->base = XFIXNUM(Vprint_base);
+    if (opts->base < 2 || opts->base > 16) {
+        opts->base = 10;
+    }
+    opts->base_upper = !NILP(Vprint_base_upper);
+    CHECK_TYPE(Vprint_precision, TYPE_FIXNUM);
+    opts->precision = XFIXNUM(Vprint_precision);
+    if (opts->precision < 0) {
+        opts->precision = 0;
+    } 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,
+                               LispVal *print_char_fun) {
+    init_print_options(&pc->opts, readable);
+    if (NILP(print_char_fun)) {
+        pc->print_char_fun = Qwrite_byte;
+    } else {
+        pc->print_char_fun = print_char_fun;
+    }
+    pc->seen_objects = Fmake_hash_table(Qnil, Qnil);
+    pc->length_stack = Qnil;
+}
+
+static void print_char(struct PrintContext *restrict pc, char c) {
+    CALL(pc->print_char_fun, MAKE_FIXNUM(c));
+}
+
+static void print_buffer(struct PrintContext *restrict pc,
+                         const char *restrict buf, size_t len) {
+    for (size_t i = 0; i < len; ++i) {
+        print_char(pc, buf[i]);
+    }
+}
+#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:
+        print_char(pc, '2');
+        break;
+    case 8:
+        print_char(pc, '8');
+        break;
+    case 10:
+        print_char(pc, '1');
+        print_char(pc, '0');
+        break;
+    case 16:
+        print_char(pc, '1');
+        print_char(pc, '6');
+        break;
+    default:
+        // TODO error
+        abort();
+    }
+    print_char(pc, '#');
+}
+
+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'));
+    } else {
+        if (pc->opts.base != 10 && pc->opts.readable) {
+            print_fixnum_base(pc, val);
+        }
+        if (fn < 0) {
+            fn = -fn;
+            print_char(pc, '-');
+        }
+        // smallest base is 2
+        fixnum_t base = pc->opts.base;
+        char buf[64];
+        size_t num_len = 0;
+        while (fn) {
+            fixnum_t digit = fn % base;
+            fn /= base;
+            char to_print;
+            if (digit >= 0 && digit <= 9) {
+                to_print = '0' + digit;
+            } else if (digit >= 10 && digit <= 15) {
+                to_print = (pc->opts.base_upper ? 'A' : 'a') + digit - 10;
+            } else {
+                abort();
+            }
+            buf[63 - (num_len++)] = to_print;
+        }
+        print_buffer(pc, &buf[64 - num_len], num_len);
+    }
+}
+
+static void print_float(struct PrintContext *restrict pc, LispVal *val) {
+    lisp_float_t fv = XLISP_FLOAT(val);
+    switch (fpclassify(fv)) {
+    case FP_ZERO:
+        PRINT_STATIC_BUFFER(pc, "0.0");
+        break;
+    case FP_NAN:
+        PRINT_STATIC_BUFFER(pc, "0.0eNaN");
+        break;
+    case FP_INFINITE:
+        if (fv < 0.0) {
+            PRINT_STATIC_BUFFER(pc, "0.0eInf");
+        } else {
+            PRINT_STATIC_BUFFER(pc, "-0.0eInf");
+        }
+        break;
+    case FP_SUBNORMAL:
+    case FP_NORMAL: {
+        char fmt[16];
+        int written =
+            snprintf(fmt, sizeof(fmt), "%%.%" LISP_FIXNUM_PRINTF(d) "g",
+                     pc->opts.precision);
+        assert(written < sizeof(fmt));
+        char buffer[32];
+        written = snprintf(buffer, sizeof(buffer), fmt, fv);
+        assert(written < sizeof(buffer));
+        size_t i;
+        for (i = 0; i < written && buffer[i] != 'e'; ++i) {
+            if (buffer[i] == '.') {
+                goto no_add;
+            }
+        }
+        memmove(buffer + i + 2, buffer + i, written - i);
+        buffer[i] = '.';
+        buffer[i + 1] = '0';
+        written += 2;
+    no_add:
+        print_buffer(pc, buffer, written);
+    } break;
+    default:
+        abort();
+    }
+}
+
+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:
+        print_fixnum(pc, val);
+        break;
     case TYPE_FLOAT:
+        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();
     }
 }
 
-DEFUN(princ, "princ", (LispVal * val), "(val)", "") {
+// Not readable
+DEFUN(princ, "princ", (LispVal * val, LispVal *print_char_fun),
+      "(val &optional print-char-fun)", "") {
     struct PrintContext pc;
-    init_print_context(&pc);
+    init_print_context(&pc, false, print_char_fun);
     print_driver(&pc, val);
     return Qnil;
 }
 
-DEFUN(prin1, "prin1", (LispVal * val), "(val)", "") {
+// Readable
+DEFUN(prin1, "prin1", (LispVal * val, LispVal *print_char_fun),
+      "(val &optional print-char-fun)", "") {
     struct PrintContext pc;
-    init_print_context(&pc);
+    init_print_context(&pc, true, print_char_fun);
     print_driver(&pc, val);
     return Qnil;
 }

src/print.h

@@ -8,11 +8,18 @@
 DECLARE_VARIABLE(print_circular);
 DECLARE_VARIABLE(print_length);
 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));
 
 // Pretty print
-DECLARE_FUNCTION(princ, (LispVal * val));
+DECLARE_FUNCTION(princ, (LispVal * val, LispVal *print_char_fun));
 // Quoted print
-DECLARE_FUNCTION(prin1, (LispVal * val));
+DECLARE_FUNCTION(prin1, (LispVal * val, LispVal *print_char_fun));
 
 __attribute__((no_sanitize("address"))) void debug_print(FILE *file,
                                                          LispVal *obj);

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;
@@ -315,6 +306,7 @@ LispVal *next_number_or_symbol(ReadStream *stream, int base) {
     size_t number_start = stream->off;
     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);
@@ -339,7 +331,32 @@ LispVal *next_number_or_symbol(ReadStream *stream, int base) {
                 && stream->off - 1 != exp_start) {
                 goto change_to_symbol;
             }
-            // fallthrough
+            // for inf
+            if (c == '-' && stream->off - 1 == number_start) {
+                negative = true;
+            }
+        } else if (exp_start == stream->off - 1 && base == ANY_BASE
+                   && (c == 'n' || c == 'N')) {
+            // attempt to read "nan" or fallback to symbol
+            if (tolower(pop_char(stream)) != 'a'
+                || tolower(pop_char(stream)) != 'n') {
+                goto change_to_symbol;
+            }
+            if (SYMBOL_END_P(peek_char(stream))) {
+                return LISP_NAN;
+            }
+            goto change_to_symbol;
+        } else if (exp_start == stream->off - 1 && base == ANY_BASE
+                   && (c == 'i' || c == 'I')) {
+            // same for "inf"
+            if (tolower(pop_char(stream)) != 'n'
+                || tolower(pop_char(stream)) != 'f') {
+                goto change_to_symbol;
+            }
+            if (SYMBOL_END_P(peek_char(stream))) {
+                return 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) {

src/read.h

@@ -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;

src/stack.c

@@ -265,7 +265,7 @@ void new_lexical_variable(LispVal *name, LispVal *value) {
         abort();
     }
     if (DYNAMIC_SYMBOL_P(name)) {
-        SET_SYMBOL_VALUE(name, value);
+        push_dynamic_binding(name, value);
     } else {
         Vlexical_environment = CONS(name, CONS(value, Vlexical_environment));
     }

src/stack.h

@@ -153,4 +153,17 @@ static ALWAYS_INLINE LispVal *UNWIND_AND_RETURN(StackFrame *frame,
 }
 noreturn void continue_unwinding(void);
 
+#define UNWIND_PROTECT(body, cleanup)                        \
+    {                                                        \
+        jmp_buf _internal_jb;                                \
+        if (setjmp(_internal_jb) == 0) {                     \
+            push_unwind_protect_frame(&_internal_jb);        \
+            StackFrame *_internal_target = LISP_STACK_REF(); \
+            {body};                                          \
+            unwind_to(_internal_target);                     \
+        } else {                                             \
+            cleanup                                          \
+        }                                                    \
+    };
+
 #endif