Completely rewrite basically the whole thing

CMakeLists.txt

@@ -5,10 +5,12 @@ set(CMAKE_EXPORT_COMPILE_COMMANDS YES)
 
 project(simple-lisp)
 
-set(SOURCE_FILES main.c parse.c lisp.c)
+set(BOOTSTRAP_FILES main.c parse.c ast.c)
 
-foreach(FILE IN LISTS SOURCE_FILES)
+foreach(FILE IN LISTS BOOTSTRAP_FILES)
-  list(APPEND REAL_SOURCE_FILES "src/${FILE}")
+  list(APPEND REAL_BOOTSTRAP_FILES "bootstrap/${FILE}")
 endforeach()
 
-add_executable(simple-lisp ${REAL_SOURCE_FILES})
+add_executable(bootstrap-slc ${REAL_BOOTSTRAP_FILES})
+
+target_link_libraries(bootstrap-slc m)

bootstrap/ast.c

@@ -0,0 +1,931 @@
+#include "ast.h"
+
+#include <stdarg.h>
+#include <ctype.h>
+#include <stdlib.h>
+#include <inttypes.h>
+#include <string.h>
+#include <regex.h>
+#include <math.h>
+
+static bool next_token(TokenStream *stream, Token *out, AstErrorList **err);
+static AstNode *process_token(Token *token, TokenStream *stream,
+                              AstQuoteType in_quote, AstErrorList **err);
+static AstNode *ast_next_toplevel_internal(TokenStream *stream,
+                                           AstQuoteType in_quote,
+                                           AstErrorList **err);
+static void dump_node_list(AstNode **list, size_t count, char sdelim,
+                           char edelim, int padding, FILE *stream);
+
+static const char *DECIMAL_NUM_PAT =
+    "^([+-])?([0-9]*)\\.?([0-9]*)(e([+-]?)([0-9]*)\\.?([0-9]*))?$";
+static regex_t DECIMAL_NUM_REGEX;
+
+static const char *NON_DECIMAL_NUM_PAT =
+    "^(2|8|10|16)#([+-])?([0-9a-f]+)$";
+static regex_t NON_DECIMAL_NUM_REGEX;
+static size_t REGEX_NMATCH;
+
+void ast_init_parser() {
+    bool had_error = false;
+    int code;
+    if ((code = regcomp(&DECIMAL_NUM_REGEX, DECIMAL_NUM_PAT, REG_EXTENDED))) {
+        fprintf(stderr, "Failed to compile decimal number regex:\n%s\n",
+                DECIMAL_NUM_PAT);
+        char msg[1024];
+        regerror(code, &DECIMAL_NUM_REGEX, msg, sizeof(msg));
+        fprintf(stderr, "  %s\n", msg);
+        had_error = true;
+    }
+    if (regcomp(&NON_DECIMAL_NUM_REGEX, NON_DECIMAL_NUM_PAT, REG_EXTENDED)) {
+        if (had_error) {
+            fputc('\n', stderr);
+        }
+        fprintf(stderr, "Failed to compile non-decimal number regex:\n%s\n",
+                NON_DECIMAL_NUM_PAT);
+        char msg[1024];
+        regerror(code, &NON_DECIMAL_NUM_REGEX, msg, sizeof(msg));
+        fprintf(stderr, "  %s\n", msg);
+        had_error = true;
+    }
+    if (had_error) {
+        exit(1);
+    }
+    REGEX_NMATCH = (DECIMAL_NUM_REGEX.re_nsub > NON_DECIMAL_NUM_REGEX.re_nsub ?
+                    DECIMAL_NUM_REGEX.re_nsub : NON_DECIMAL_NUM_REGEX.re_nsub)
+                   + 1;
+}
+
+void ast_deinit_parser() {
+    regfree(&DECIMAL_NUM_REGEX);
+    regfree(&NON_DECIMAL_NUM_REGEX);
+}
+
+// vasprintf is nonstandard, open_memstream is POSIX 2008
+char *compat_vasprintf(const char *fmt, va_list args) {
+    va_list args2;
+    va_copy(args2, args);
+    size_t size = vsnprintf(NULL, 0, fmt, args) + 1;
+    char *buf = malloc(size);
+    vsnprintf(buf, size, fmt, args2);
+    va_end(args2);
+    return buf;
+}
+
+static void push_error_list_end(AstErrorList **list, AstErrorList *err) {
+    err->next = NULL;
+    if (!*list) {
+        *list = err;
+    } else {
+        AstErrorList *cur = *list;
+        while (cur->next) {
+            cur = cur->next;
+        }
+        cur->next = err;
+    }
+}
+
+__attribute__((format(printf, 4, 5)))
+static void push_build_error(AstErrorList **list, Token *token, size_t off,
+                             const char *fmt, ...) {
+    if (list) {
+        AstErrorList *n = malloc(sizeof(AstErrorList));
+        n->type = AST_ERROR_BUILD;
+        n->build.off = off;
+        n->build.token = *token;
+        token->text = NULL;
+        token->buf_len = 0;
+        va_list args;
+        va_start(args, fmt);
+        n->build.msg = compat_vasprintf(fmt, args);
+        va_end(args);
+        push_error_list_end(list, n);
+    }
+}
+
+static void push_parse_error(AstErrorList **list, ParseError *err) {
+    if (list) {
+        AstErrorList *n = malloc(sizeof(AstErrorList));
+        n->type = AST_ERROR_PARSE;
+        n->parse = err;
+        push_error_list_end(list, n);
+    }
+}
+
+static void *make_ast_node(size_t size, AstType type, size_t line,
+                           size_t col) {
+    AstNode *node = malloc(size);
+    node->type = type;
+    node->line = line;
+    node->col = col;
+    return node;
+}
+
+static int compat_strcasecmp(const char *str1, const char *str2) {
+    while (*str1 && *str2) {
+        if (tolower(*str1) != tolower(*str2)) {
+            return tolower(*str1) - tolower(*str2);
+        }
+        ++str1;
+        ++str2;
+    }
+    return tolower(*str1) - tolower(*str2);
+}
+
+// number of chars converted on success, 0 on failure
+static int convert_numeric_char_escape(const char *escape, wchar_t *out,
+                                       bool allow_trailing) {
+    size_t len = strlen(escape) - 1;
+    size_t expected_len;
+    int base;
+    if (tolower(escape[0]) == 'x') {
+        expected_len = 4;
+        base = 16;
+    } else if (tolower(escape[0]) == 'o') {
+        expected_len = 6;
+        base = 8;
+    } else if (tolower(escape[0]) == 'd') {
+        expected_len = 5;
+        base = 10;
+    }
+    if (len < expected_len || (!allow_trailing && len > expected_len)) {
+        return 0;
+    }
+    char *endptr;
+    char numbuf[expected_len + 1];
+    memcpy(numbuf, escape + 1, expected_len);
+    numbuf[expected_len] = '\0';
+    uintmax_t num = strtoumax(numbuf, &endptr, base);
+    if (*endptr) {
+        return 0;
+    }
+    *out = num;
+    return expected_len + 1;
+}
+
+static const struct {
+    char escape;
+    char value;
+} C_STYLE_ESCAPE_MAP[] = {
+    {'n', '\n'},
+    {'t', '\t'},
+    {'r', '\r'},
+    {'v', '\v'},
+    {'f', '\f'},
+    {'b', '\b'},
+    {'a', '\a'},
+    {'0', '\0'},
+    {'\\', '\\'},
+};
+const size_t C_STYLE_ESCAPE_COUNT = sizeof(C_STYLE_ESCAPE_MAP) /
+                                    sizeof(C_STYLE_ESCAPE_MAP[0]);
+
+// true on success, false on failure
+static bool convert_c_style_char_escape(const char *escape, wchar_t *out) {
+    for (size_t i = 0; i < C_STYLE_ESCAPE_COUNT; ++i) {
+        if (tolower(escape[0]) == C_STYLE_ESCAPE_MAP[i].escape) {
+            *out = C_STYLE_ESCAPE_MAP[i].value;
+            return true;
+        }
+    }
+    return false;
+}
+
+// null byte on failure
+static char escape_for_char(char to_escape) {
+    for (size_t i = 0; i < C_STYLE_ESCAPE_COUNT; ++i) {
+        if (to_escape == C_STYLE_ESCAPE_MAP[i].value) {
+            return C_STYLE_ESCAPE_MAP[i].escape;
+        }
+    }
+    return '\0';
+}
+
+static char *escape_string(const char *input, size_t input_len, size_t *out_len) {
+    size_t out_size = input_len + 1;
+    char *out = malloc(out_size);
+    *out_len = 0;
+    for (size_t i = 0; i < input_len; ++i) {
+        char escape = escape_for_char(input[i]);
+        if (escape) {
+            out = realloc(out, ++out_size);
+            out[(*out_len)++] = '\\';
+            out[(*out_len)++] = escape;
+        } else if (input[i] == '"') {
+            out = realloc(out, ++out_size);
+            out[(*out_len)++] = '\\';
+            out[(*out_len)++] = '"';
+        } else {
+            out[(*out_len)++] = input[i];
+        }
+    }
+    out[(*out_len)] = '\0';
+    return out;
+}
+
+static const struct {
+    const char *escape;
+    char value;
+} NAMED_CHAR_ESCAPE_MAP[] = {
+    {"newline", '\n'},
+    {"tab", '\t'},
+    {"return", '\r'},
+    {"vtab", '\v'},
+    {"page_break", '\f'},
+    {"backspace", '\b'},
+    {"alert", '\a'},
+    {"null", '\0'},
+    {"backslash", '\\'},
+};
+static const size_t NAMED_CHAR_COUNT = sizeof(NAMED_CHAR_ESCAPE_MAP) /
+                                       sizeof(NAMED_CHAR_ESCAPE_MAP[0]);
+
+// true on success, false on failure
+static bool convert_named_char_escape(const char *escape, wchar_t *out) {
+    for (size_t i = 0; i < NAMED_CHAR_COUNT; ++i) {
+        if (compat_strcasecmp(NAMED_CHAR_ESCAPE_MAP[i].escape, escape) == 0) {
+            *out = NAMED_CHAR_ESCAPE_MAP[i].value;
+            return true;
+        }
+    }
+    return false;
+}
+
+static AstIntNode *process_char_token(Token *token, AstErrorList **err) {
+    AstIntNode *node = make_ast_node(sizeof(AstIntNode), AST_TYPE_INT,
+                                     token->line, token->col);
+    // remove the # sign
+    char *sym = token->text + 1;
+    // special character
+    if (sym[0] == '\\') {
+        // account for '#' in token->len
+        if (token->len < 3) {
+            push_build_error(err, token, 1, "expected escape sequence");
+            free(node);
+            return NULL;
+        }
+        wchar_t c;
+        if (!convert_named_char_escape(sym + 1,  &c) &&
+            !convert_c_style_char_escape(sym + 1,  &c) &&
+            !convert_numeric_char_escape(sym + 1, &c, false)) {
+            free(token->text);
+            free(node);
+            push_build_error(err, token, 0,
+                             "invalid escape sequence in character literal");
+            return NULL;
+        }
+        node->value = c;
+    } else {
+        node->value = sym[0];
+    }
+    return node;
+}
+
+static char *process_string_escapes(Token *token, size_t *out_len,
+                                    AstErrorList **err) {
+    const char *text = token->text;
+    size_t out_size = token->len + 1;
+    char *out = malloc(out_size);
+    *out_len = 0;
+    bool backslash = 0;
+    for (size_t i = 1; i < token->len - 1; ++i) {
+        if (!backslash && text[i] == '\\') {
+            backslash = true;
+            continue;
+        } else if (backslash && text[i] == '\n') {
+            // backslash can escape a newline
+        } else if (backslash) {
+            size_t count = 1;
+            wchar_t c;
+            if (!convert_c_style_char_escape(&text[i], &c) &&
+                !(count = convert_numeric_char_escape(&text[i], &c, true))) {
+                push_build_error(err, token, i, "invalid escape sequence");
+                return NULL;
+            }
+            if (out_size - *out_len - 1 < MB_CUR_MAX) {
+                out_size = out_size + MB_CUR_MAX - (out_size - *out_len - 1);
+                out = realloc(out, out_size);
+            }
+            *out_len += wctomb(out + *out_len, c);
+            i += count - 1;
+        } else {
+            if (*out_len >= out_size) {
+                out = realloc(out, out_size + token->len - i + 1);
+            }
+            out[(*out_len)++] = text[i];
+        }
+        backslash = false;
+    }
+    out = realloc(out, *out_len + 1);
+    out[*out_len] = '\0';
+    return out;
+}
+
+static AstStringNode *process_string_token(Token *token, AstErrorList **err) {
+    AstStringNode *node = make_ast_node(sizeof(AstStringNode), AST_TYPE_STRING,
+                                        token->line, token->col);
+    node->value = process_string_escapes(token, &node->length, err);
+    if (!node->value) {
+        free(node);
+        node = NULL;
+    }
+    return node;
+}
+
+static AstNode *make_null_node(size_t line, size_t col) {
+    return make_ast_node(sizeof(AstNode), AST_TYPE_NULL, line, col);
+}
+
+static AstNode *process_symbol_token(Token *token) {
+    if (strcmp(token->text, "nil") == 0) {
+        return (AstNode *) make_null_node(token->line, token->col);
+    }
+    AstSymbolNode *node = make_ast_node(sizeof(AstSymbolNode), AST_TYPE_SYMBOL,
+                                        token->line, token->col);
+    node->name = token->text;
+    node->name_length = token->len;
+    node->is_property = token->text[0] == ':';
+    node->skip_free = false;
+    token->text = NULL;
+    token->buf_len = 0;
+    return (AstNode *) node;
+}
+
+static int sign_for_match(Token *token, regmatch_t *match) {
+    if (match->rm_so != match->rm_eo &&
+        token->text[match->rm_so] == '-') {
+        return -1;
+    } else {
+        return 1;
+    }
+}
+
+static void break_number_for_matches(Token *token, regmatch_t *matches,
+                                     int main, int dec, uintmax_t *main_out,
+                                     uintmax_t *dec_out) {
+    const char *text = token->text;
+    regmatch_t *mm = &matches[main];
+    regmatch_t *dm = &matches[dec];
+    *main_out = 0;
+    // main number has at least 1 char
+    if (mm->rm_eo - mm->rm_so) {
+        *main_out = strtoumax(text + mm->rm_so, NULL, 10);
+    }
+    *dec_out = 0;
+    // decimal number has at least 1 char
+    if (dm->rm_eo - dm->rm_so) {
+        *dec_out = strtoumax(text + dm->rm_so, NULL, 10);
+    }
+}
+
+static AstNode *process_decimal_matches(Token *token, regmatch_t *matches) {
+    int main_sign = sign_for_match(token, &matches[1]);
+    int exp_sign = sign_for_match(token, &matches[5]);
+    uintmax_t main_main, main_dec;
+    break_number_for_matches(token, matches, 2, 3, &main_main, &main_dec);
+    uintmax_t exp_main, exp_dec;
+    break_number_for_matches(token, matches, 6, 7, &exp_main, &exp_dec);
+    if (main_dec == 0 && exp_dec == 0 && exp_sign == 1) {
+        // return an integer
+        AstIntNode *node = make_ast_node(sizeof(AstIntNode), AST_TYPE_INT,
+                                         token->line, token->col);
+        node->value = main_sign * main_main * pow(10, exp_main);
+        return (AstNode *) node;
+    } else {
+        // return a float
+        AstFloatNode *node = make_ast_node(sizeof(AstFloatNode), AST_TYPE_FLOAT,
+                                           token->line, token->col);
+        int main_dec_len = floor(log10(main_dec) + 1);
+        int exp_dec_len = floor(log10(exp_dec) + 1);
+        double main_dec_f = main_dec * pow(10, -main_dec_len);
+        double exp_dec_f = exp_dec * pow(10, -exp_dec_len);
+        node->value = main_sign * ((double) main_main + main_dec_f) *
+                      pow(10, exp_sign * ((double) exp_main + exp_dec_f));
+        return (AstNode *) node;
+    }
+}
+
+static AstNode *process_non_decimal_matches(Token *token, regmatch_t *matches,
+                                            AstErrorList **err) {
+    // get the base
+    int base;
+    if (token->text[0] == '2' || token->text[0] == '8') {
+        base = token->text[0] - '0';
+    } else {
+        base = 10 + token->text[1] - '0';
+    }
+    int sign = sign_for_match(token, &matches[2]);
+    char *endptr;
+    uintmax_t num = strtoumax(&token->text[matches[3].rm_so], &endptr, base);
+    // num is the abs of our target, so only check against positive max
+    if (*endptr || num > INT64_MAX) {
+        push_build_error(err, token, 0, "invalid numeric literal");
+        return NULL;
+    }
+    AstIntNode *node = make_ast_node(sizeof(AstIntNode), AST_TYPE_INT,
+                                     token->line, token->col);
+    node->value = sign * (intmax_t) num;
+    return (AstNode *) node;
+}
+
+static AstNode *parse_number_token(Token *token, AstErrorList **err) {
+    regmatch_t matches[REGEX_NMATCH];
+    const char *text = token->text;
+    if (regexec(&DECIMAL_NUM_REGEX, text, REGEX_NMATCH, matches, 0) == 0) {
+        return process_decimal_matches(token, matches);
+    } else if (regexec(&NON_DECIMAL_NUM_REGEX, text, REGEX_NMATCH,
+                       matches, 0) == 0) {
+        return process_non_decimal_matches(token, matches, err);
+    }
+    push_build_error(err, token, 0, "invalid numeric literal");
+    return NULL;
+}
+
+static bool is_node_symbol_t(AstNode *node) {
+    return node->type == AST_TYPE_SYMBOL &&
+           strcmp("t", ((AstSymbolNode *) node)->name) == 0;
+}
+
+static AstNode *simplify_quote_node(AstQuoteNode *node) {
+    AstNode *cur = (AstNode *) node;
+    while (cur->type == AST_TYPE_QUOTE) {
+        cur = ((AstQuoteNode *) cur)->form;
+    }
+    if (cur->type == AST_TYPE_NULL
+        || cur->type == AST_TYPE_VECTOR
+        || is_node_symbol_t(cur)) {
+        AstNode *inner = node->form;
+        node->form = NULL;
+        destroy_ast_node(node);
+        return inner;
+    }
+    return (AstNode *) node;
+}
+
+static AstNode *quote_ast_form(AstQuoteType type,
+                               AstNode *form, size_t line, size_t col,
+                               AstQuoteType in_quote) {
+    AstQuoteNode *node = make_ast_node(sizeof(AstQuoteNode), AST_TYPE_QUOTE,
+                                       line, col);
+    node->type = type;
+    node->form = form;
+    if (!in_quote) {
+        return simplify_quote_node(node);
+    }
+    return (AstNode *) node;
+}
+
+static AstNode *quote_next_toplevel(Token *token, TokenStream *stream,
+                                    AstQuoteType in_quote, AstErrorList **err) {
+    AstQuoteType my_type;
+    switch (token->type) {
+    case TOKEN_TYPE_QUOTE:
+        my_type = AST_QUOTE_NORM;
+        break;
+    case TOKEN_TYPE_BACKQUOTE:
+        my_type = AST_QUOTE_BACK;
+        break;
+    case TOKEN_TYPE_COMMA:
+        my_type = AST_QUOTE_COMMA;
+        break;
+    case TOKEN_TYPE_SPLICE:
+        my_type = AST_QUOTE_SPLICE;
+        break;
+    default:
+        // shouldn't happen
+        abort();
+        break;
+    }
+    if (in_quote != AST_QUOTE_BACK &&
+        (my_type == AST_QUOTE_COMMA || my_type == AST_QUOTE_SPLICE)) {
+        push_build_error(err, token, 0, "comma or splice not inside a backquote");
+        return NULL;
+    }
+    if (my_type > in_quote) {
+        in_quote = my_type;
+    }
+    AstNode *internal = ast_next_toplevel_internal(stream, in_quote, err);
+    if (!internal) {
+        // error already reported
+        return NULL;
+    }
+    return quote_ast_form(my_type, internal, token->line, token->col, in_quote);
+}
+
+static bool is_close_delim(Token *token) {
+    return (token->type == TOKEN_TYPE_PAREN || token->type == TOKEN_TYPE_BRACKET)
+           && (token->text[0] == ')' || token->text[0] == ']');
+}
+
+static bool is_close_delim_for(Token *token, Token *child) {
+    if (token->type == child->type) {
+        switch (token->type) {
+        case TOKEN_TYPE_PAREN:
+            return child->text[0] == ')';
+        case TOKEN_TYPE_BRACKET:
+            return child->text[0] == ']';
+        default:
+            // fall-through
+            break;
+        }
+    }
+    return false;
+}
+
+
+static AstNode *process_next_list_or_vector(Token *token, TokenStream *stream,
+                                            size_t size, AstType type,
+                                            off_t child_arr_off,
+                                            off_t child_count_off,
+                                            AstQuoteType in_quote,
+                                            AstErrorList **err) {
+    if (is_close_delim(token)) {
+        push_build_error(err, token, 0, "unmatched closing delimiter");
+        return NULL;
+    }
+    AstNode *node = make_ast_node(size, type, token->line, token->col);
+    AstNode ***child_arr_ptr = (void *) node + child_arr_off;
+    size_t *child_count_ptr = (void *) node + child_count_off;
+    *child_arr_ptr = NULL;
+    *child_count_ptr = 0;
+    bool error = false;
+    Token ctok;
+    ctok.text = NULL;
+    ctok.buf_len = 0;
+    while (true) {
+        if (!next_token(stream, &ctok, err)) {
+            // node MUST be valid for this to work
+            destroy_ast_node(node);
+            node = NULL;
+            break;
+        }
+        if (is_close_delim_for(token, &ctok)) {
+            break;
+        }
+        AstNode *cnode = process_token(&ctok, stream, in_quote, err);
+        if (!cnode) {
+            error = true;
+            if (token_stream_is_eof(stream)) {
+                push_build_error(err, token, 0, "unmatched opening delimiter");
+                break;
+            }
+        }
+        *child_arr_ptr = realloc(*child_arr_ptr, sizeof(AstNode *) *
+                                                 ++(*child_count_ptr));
+        (*child_arr_ptr)[(*child_count_ptr) - 1] = cnode;
+    }
+    free(ctok.text);
+    if (error) {
+        destroy_ast_node(node);
+        return NULL;
+    }
+    return node;
+}
+
+static bool is_quote_symbol_node(AstNode *node) {
+    return node->type == AST_TYPE_SYMBOL &&
+           strcmp(((AstSymbolNode *) node)->name, "quote") == 0;
+}
+
+static AstNode *process_next_list(Token *token, TokenStream *stream,
+                                  AstQuoteType in_quote, AstErrorList **err) {
+    AstListNode *node = (AstListNode *)
+      process_next_list_or_vector(token, stream, sizeof(AstListNode),
+                                  AST_TYPE_LIST, offsetof(AstListNode, children),
+                                  offsetof(AstListNode, nchildren), in_quote, err);
+    if (!node) {
+        return NULL;
+    } else if (node->nchildren == 0) {
+        destroy_ast_node(node);
+        return (AstNode *) make_null_node(token->line, token->col);
+    }
+    bool is_quote = is_quote_symbol_node(node->children[0]);
+    if (is_quote && node->nchildren != 2) {
+        push_build_error(err, token, 0, "quote expects one argument, got %zu",
+                         node->nchildren);
+        destroy_ast_node(node);
+        return NULL;
+    } else if (is_quote) {
+        AstNode *internal = node->children[1];
+        node->nchildren = 1;
+        destroy_ast_node(node);
+        return (AstNode *)quote_ast_form(AST_QUOTE_NORM, internal,
+                                         token->line, token->col,
+                                         in_quote);
+    }
+    return (AstNode *) node;
+}
+
+// true on success, false on error
+static bool next_token(TokenStream *stream, Token *out, AstErrorList **err) {
+    out->text = NULL;
+    out->buf_len = 0;
+    do {
+        token_stream_next(stream, out);
+        ParseError *parse_err;
+        bool had_error = false;
+        while ((parse_err = token_stream_error(stream))) {
+            push_parse_error(err, parse_err);
+            had_error = true;
+        }
+        if (had_error) {
+            free(out->text);
+            out->text = NULL;
+            out->buf_len = 0;
+            return false;
+        }
+    } while (out->type == TOKEN_TYPE_COMMENT);
+    return true;
+}
+
+static AstNode *process_token(Token *token, TokenStream *stream,
+                              AstQuoteType in_quote, AstErrorList **err) {
+    AstNode *retval = NULL;
+    switch (token->type) {
+    case TOKEN_TYPE_CHAR:
+        retval = (AstNode *) process_char_token(token, err);
+        break;
+    case TOKEN_TYPE_NUMBER:
+        retval = parse_number_token(token, err);
+        break;
+    case TOKEN_TYPE_STRING:
+        retval = (AstNode *) process_string_token(token, err);
+        break;
+    case TOKEN_TYPE_SYMBOL:
+    case TOKEN_TYPE_PROPERTY:
+        retval = (AstNode *) process_symbol_token(token);
+        break;
+    case TOKEN_TYPE_BACKQUOTE:
+    case TOKEN_TYPE_COMMA:
+    case TOKEN_TYPE_SPLICE:
+    case TOKEN_TYPE_QUOTE:
+        retval = (AstNode *) quote_next_toplevel(token, stream, in_quote, err);
+        break;
+    case TOKEN_TYPE_PAREN:
+        retval = process_next_list(token, stream, in_quote, err);
+        break;
+    case TOKEN_TYPE_BRACKET:
+        retval = process_next_list_or_vector(token, stream, sizeof(AstVectorNode),
+                                             AST_TYPE_VECTOR,
+                                             offsetof(AstVectorNode, children),
+                                             offsetof(AstVectorNode, nchildren),
+                                             AST_QUOTE_NORM, err);
+        break;
+    case TOKEN_TYPE_UNKNOWN:
+        push_build_error(err, token, 0, "unknown token");
+        break;
+    case TOKEN_TYPE_EOF:
+        // do nothing
+        break;
+    case TOKEN_TYPE_COMMENT:
+        // shouldn't happen
+        abort();
+        break;
+    }
+    return retval;
+}
+
+static AstNode *ast_next_toplevel_internal(TokenStream *stream,
+                                           AstQuoteType in_quote,
+                                           AstErrorList **err) {
+    Token token;
+    token.text = NULL;
+    token.buf_len = 0;
+    if (!next_token(stream, &token, err)) {
+        return NULL;
+    }
+    return process_token(&token, stream, in_quote, err);
+}
+
+AstNode *ast_next_toplevel(TokenStream *stream, AstErrorList **err) {
+    return ast_next_toplevel_internal(stream, AST_QUOTE_NONE, err);
+}
+
+void destroy_ast_node(void *node) {
+    if (!node) {
+        return;
+    }
+    switch (((AstNode *)node)->type) {
+    case AST_TYPE_LIST:
+        for (size_t i = 0; i < ((AstListNode *) node)->nchildren; ++i) {
+            destroy_ast_node(((AstListNode *) node)->children[i]);
+        }
+        free(((AstListNode *) node)->children);
+        break;
+    case AST_TYPE_VECTOR:
+        for (size_t i = 0; i < ((AstVectorNode *) node)->nchildren; ++i) {
+            destroy_ast_node(((AstVectorNode *) node)->children[i]);
+        }
+        free(((AstVectorNode *) node)->children);
+        break;
+    case AST_TYPE_STRING:
+        free(((AstStringNode *) node)->value);
+        break;
+    case AST_TYPE_SYMBOL:
+        if (!((AstSymbolNode *)node)->skip_free) {
+            free(((AstSymbolNode *) node)->name);
+        }
+        break;
+    case AST_TYPE_QUOTE:
+        destroy_ast_node(((AstQuoteNode *) node)->form);
+        break;
+    case AST_TYPE_INT:
+    case AST_TYPE_FLOAT:
+    case AST_TYPE_NULL:
+        break;
+    }
+    free(node);
+}
+
+static const char *str_for_ast_quote_type(AstQuoteType type) {
+    switch (type) {
+    case AST_QUOTE_NONE:
+        return "";
+    case AST_QUOTE_NORM:
+        return "'";
+    case AST_QUOTE_BACK:
+        return "`";
+    case AST_QUOTE_COMMA:
+        return ",";
+    case AST_QUOTE_SPLICE:
+        return ",@";
+    }
+}
+
+static void ast_prin1_node_internal(AstNode *node, FILE *stream, int padding,
+                                    bool skip_print_pad) {
+    if (!skip_print_pad) {
+        for (int i = 0; i < padding; ++i) {
+            fputc(' ', stream);
+        }
+    }
+    switch (node->type) {
+    case AST_TYPE_INT: {
+        int64_t value = ((AstIntNode *) node)->value;
+        fprintf(stream, "%" PRId64 " (", value);
+        char escape;
+        if ((escape = escape_for_char((char) value))) {
+            fprintf(stream, "#\\%c, ", escape);
+        } else if (isprint(value)) {
+            fprintf(stream, "#%c, ", (char) value);
+        }
+        if (value < 0) {
+            fputc('-', stream);
+            value *= -1;
+        }
+        fprintf(stream, "0x%" PRIx64 ")", value);
+    }
+        break;
+    case AST_TYPE_STRING: {
+        size_t escaped_len;
+        char *escaped_string = escape_string(((AstStringNode *)node)->value,
+                                             ((AstStringNode *)node)->length,
+                                             &escaped_len);
+        fputc('"', stream);
+        fwrite(escaped_string, 1, escaped_len, stream);
+        fputc('"', stream);
+    }
+        break;
+    case AST_TYPE_SYMBOL:
+        fwrite(((AstSymbolNode *) node)->name, 1,
+               ((AstSymbolNode *) node)->name_length, stream);
+        break;
+    case AST_TYPE_FLOAT:
+        fprintf(stream, "%g", ((AstFloatNode *) node)->value);
+        break;
+    case AST_TYPE_LIST: {
+        dump_node_list(((AstListNode *) node)->children,
+                       ((AstListNode *) node)->nchildren,
+                       '(', ')', padding, stream);
+    }
+        break;
+    case AST_TYPE_VECTOR:
+        dump_node_list(((AstVectorNode *) node)->children,
+                       ((AstVectorNode *) node)->nchildren,
+                       '[', ']', padding, stream);
+        break;
+    case AST_TYPE_QUOTE: {
+        const char *quote_str = str_for_ast_quote_type(((AstQuoteNode *) node)->type);
+        fprintf(stream, "%s", quote_str);
+        padding += strlen(quote_str);
+        ast_prin1_node_internal(((AstQuoteNode *) node)->form, stream,
+                                padding, true);
+        
+    }
+        break;
+    case AST_TYPE_NULL:
+        fwrite("nil", 1, 3, stream);
+        break;
+    }
+}
+
+static void dump_node_list(AstNode **list, size_t count, char sdelim,
+                           char edelim, int padding, FILE *stream) {
+    fputc(sdelim, stream);
+    if (count) {
+        ast_prin1_node_internal(list[0], stream, padding + 1, true);
+    }
+    for (size_t i = 1; i < count; ++i) {
+        fputc('\n', stream);
+        ast_prin1_node_internal(list[i], stream, padding + 1, false);
+    }
+    fputc(edelim, stream);
+}
+
+void ast_prin1_node(AstNode *node, FILE *stream) {
+    ast_prin1_node_internal(node, stream, 0, false);
+    fputc('\n', stream);
+}
+
+AstErrorList *ast_error_list_pop(AstErrorList **list) {
+    AstErrorList *top = *list;
+    if (*list) {
+        *list = (*list)->next;
+    }
+    return top;
+}
+
+void ast_error_list_free_one(AstErrorList *list) {
+    if (list) {
+        switch (list->type) {
+        case AST_ERROR_PARSE:
+            parse_error_free(list->parse);
+            break;
+        case AST_ERROR_BUILD:
+            free(list->build.msg);
+            token_free(&list->build.token);
+            break;
+        }
+        free(list);
+    }
+}
+
+void ast_error_list_free_all(AstErrorList *list) {
+    while (list) {
+        AstErrorList *next = list->next;
+        ast_error_list_free_one(list);
+        list = next;
+    }
+}
+
+static const char *start_of_last_line(const char *str, size_t len,
+                                      size_t *line_len, size_t *num_passed) {
+    *num_passed = 0;
+    *line_len = 0;
+    const char *retval = str;
+    size_t i;
+    for (i = len; i > 0; --i) {
+        if (str[i - 1] == '\n' && *line_len) {
+            retval = &str[i];
+            break;
+        } else if (str[i - 1] != '\n') {
+            ++(*line_len);
+        }
+    }
+    for (; i > 0; --i) {
+        if (str[i - 1] == '\n') {
+            ++*num_passed;
+        }
+    }
+    return retval;
+}
+
+void ast_format_error(AstErrorList *err, const char *file_name, FILE *stream) {
+    if (!err) {
+        return;
+    }
+    fprintf(stream, "error: ");
+    if (file_name) {
+        fprintf(stream, "%s: ", file_name);
+    }
+    switch (err->type) {
+    case AST_ERROR_PARSE: {
+        size_t line_len;
+        size_t num_passed;
+        const char *last_line = start_of_last_line(err->parse->context,
+                                                   strlen(err->parse->context),
+                                                   &line_len, &num_passed);
+        fprintf(stream, "%zu:%zu: %s\n ", err->parse->line + num_passed,
+                err->parse->at_end ? err->parse->col + line_len - 1 :
+                err->parse->col, err->parse->desc);
+        fwrite(last_line, 1, line_len, stream);
+        fwrite("\n  ", 1, 3, stream);
+        if (err->parse->at_end) {
+            for (size_t i = 1; i < line_len; ++i) {
+                fputc(' ', stream);
+            }
+        }
+        fwrite("^\n", 1, 2, stream);
+    }
+        break;
+    case AST_ERROR_BUILD:
+        fprintf(stream, "%zu:%zu: %s\n  %s\n  ", err->build.token.line,
+                err->build.token.col + err->build.off,
+                err->build.msg, err->build.token.text);
+        for (size_t i = 1; i <= err->build.off; ++i) {
+            fputc(' ', stream);
+        }
+        fwrite("^\n", 1, 2, stream);
+        break;
+    }
+}

bootstrap/ast.h

@@ -0,0 +1,108 @@
+#ifndef INCLUDED_AST_H
+#define INCLUDED_AST_H
+
+#include "parse.h"
+
+#include <stddef.h>
+#include <stdint.h>
+
+typedef enum {
+    AST_TYPE_LIST,
+    AST_TYPE_SYMBOL,
+    AST_TYPE_VECTOR,
+    AST_TYPE_INT,
+    AST_TYPE_FLOAT,
+    AST_TYPE_STRING,
+    AST_TYPE_QUOTE,
+    AST_TYPE_NULL,
+} AstType;
+
+typedef struct {
+    AstType type;
+    size_t line;
+    size_t col;
+} AstNode;
+
+typedef struct {
+    AstNode parent;
+    size_t nchildren;
+    AstNode **children;
+} AstListNode;
+
+typedef struct {
+    AstNode parent;
+    size_t nchildren;
+    AstNode **children;
+} AstVectorNode;
+
+typedef struct {
+    AstNode parent;
+    int64_t value;
+} AstIntNode;
+
+typedef struct {
+    AstNode parent; 
+    double value;
+} AstFloatNode;
+
+typedef struct {
+    AstNode parent;
+    char *value;
+    size_t length;
+} AstStringNode;
+
+typedef struct {
+    AstNode parent;
+    bool is_property;
+    char *name;
+    size_t name_length;
+    bool skip_free;
+} AstSymbolNode;
+
+typedef enum {
+    AST_QUOTE_NONE = 0,
+    AST_QUOTE_COMMA,
+    AST_QUOTE_SPLICE,
+    AST_QUOTE_NORM,
+    AST_QUOTE_BACK,
+} AstQuoteType;
+
+typedef struct {
+    AstNode parent;
+    AstQuoteType type;
+    AstNode *form;
+} AstQuoteNode;
+
+typedef enum {
+    AST_ERROR_PARSE,
+    AST_ERROR_BUILD
+} AstErrorType;
+
+typedef struct _AstErrorList {
+    struct _AstErrorList *next;
+    AstErrorType type;
+    union {
+        ParseError *parse;
+        struct {
+            Token token;
+            size_t off; // from start of token
+            char *msg;
+        } build;
+    };
+} AstErrorList;
+
+void ast_init_parser(void);
+void ast_deinit_parser(void);
+
+AstNode *ast_next_toplevel(TokenStream *stream, AstErrorList **err);
+
+void destroy_ast_node(void *node);
+
+AstErrorList *ast_error_list_pop(AstErrorList **list);
+void ast_error_list_free_one(AstErrorList *list);
+void ast_error_list_free_all(AstErrorList *list);
+
+void ast_prin1_node(AstNode *node, FILE *stream);
+void ast_format_error(AstErrorList *err, const char *file_name, FILE *stream);
+
+#endif

bootstrap/main.c

@@ -0,0 +1,29 @@
+#include <stdio.h>
+
+#include "parse.h"
+#include "ast.h"
+
+int main(int argc, const char **argv) {
+    ast_init_parser();
+    FILE *file = fopen("bootstrap/test.sl", "r");
+    if (!file) {
+        perror("fopen");
+    }
+    TokenStream *stream = make_token_stream(file);
+    AstErrorList *errs;
+    while (!token_stream_is_eof(stream)) {
+        AstNode *node = ast_next_toplevel(stream, &errs);
+        if (node) {
+            ast_prin1_node(node, stdout);
+        }
+        while (errs) {
+            AstErrorList *err = ast_error_list_pop(&errs);
+            ast_format_error(err, "bootstrap/test.sl", stderr);
+            ast_error_list_free_one(err);
+        }
+        destroy_ast_node(node);
+    }
+    destroy_token_stream(stream);
+    ast_deinit_parser();
+    return 0;
+}

bootstrap/parse.c

@@ -4,6 +4,39 @@
 #include <stdlib.h>
 #include <string.h>
 
+const char *token_type_to_str(TokenType type) {
+    switch (type) {
+    case TOKEN_TYPE_EOF:
+        return "EOF";
+    case TOKEN_TYPE_COMMENT:
+        return "COMMENT";
+    case TOKEN_TYPE_PAREN:
+        return "PAREN";
+    case TOKEN_TYPE_BRACKET:
+        return "BRACKET";
+    case TOKEN_TYPE_SYMBOL:
+        return "SYMBOL";
+    case TOKEN_TYPE_PROPERTY:
+        return "PROPERTY";
+    case TOKEN_TYPE_QUOTE:
+        return "QUOTE";
+    case TOKEN_TYPE_NUMBER:
+        return "NUMBER";
+    case TOKEN_TYPE_CHAR:
+        return "CHAR";
+    case TOKEN_TYPE_STRING:
+        return "STRING";
+    case TOKEN_TYPE_COMMA:
+        return "COMMA";
+    case TOKEN_TYPE_BACKQUOTE:
+        return "BACKQUOTE";
+    case TOKEN_TYPE_SPLICE:
+        return "SPLICE";
+    case TOKEN_TYPE_UNKNOWN:
+        return "UNKNOWN";
+    }
+}
+
 static void append_char(Token *token, char new_char) {
     if (token->len >= token->buf_len) {
         token->buf_len = token->len + 1;
@@ -31,18 +64,20 @@ static void copy_to_buffer(Token *token, const char *src, size_t src_len) {
 }
 
 static int issymbolend(int c) {
-    return isspace(c) || c == ')' || c == ']';
+    return isspace(c) || c == ')' || c == ']' || c == '(' ||
+           c == '[' || c == ',';
 }
 
 // takes the string arguments
 static void token_stream_push_error(TokenStream *stream, Token *token,
-                                    char *desc) {
+                                    char *desc, bool at_end) {
     ParseError *err = malloc(sizeof(ParseError));
     err->next = NULL;
     err->col = token->col;
     err->line = token->line;
     err->desc = desc;
     err->context = malloc(token->len + 1);
+    err->at_end = at_end;
     memcpy(err->context, token->text, token->len);
     err->context[token->len] = '\0';
     if (stream->error_tail) {
@@ -120,6 +155,9 @@ static void next_string(TokenStream *stream, Token *token) {
         if (c == '\\' && !backslash) {
             backslash = true;
         } else {
+            if (backslash && c != '"') {
+                append_char(token, '\\');
+            }
             backslash = false;
             append_char(token, c);
             if (c == '\n') {
@@ -131,11 +169,13 @@ static void next_string(TokenStream *stream, Token *token) {
         }
     }
     ++stream->col;
-    append_char(token, '"');
-    append_null_byte(token);
     if (feof(stream->src)) {
-        token_stream_push_error(stream, token,
+        token_stream_push_error(stream, token, strdup("expected '\"', got EOF"),
-                                strdup("expected '\"', got EOF"));
+                                true);
+        append_null_byte(token);
+    } else {
+        append_char(token, '"');
+        append_null_byte(token);
     }
 }
 
@@ -163,21 +203,28 @@ static void next_char_literal(TokenStream *stream, Token *token) {
     stream->col += 2;
     if (c == EOF) {
         token_stream_push_error(stream, token,
-                                strdup("expected character literal, got EOF"));
+                                strdup("expected character literal, got EOF"),
+                                true);
         token->len = 0;
         token->type = TOKEN_TYPE_UNKNOWN;
+        c = fgetc(stream->src);
     } else if (c == '\\') {
-        // named character literal, like "#\newline"
+        // named character literal, like "#\n"
-        while ((c = fgetc(stream->src)) != EOF && isalpha(c)) {
+        while ((c = fgetc(stream->src)) != EOF &&
+               (isalpha(c) || isdigit(c) || c == '\\')) {
             append_char(token, c);
             ++stream->col;
         }
+    } else {
+        c = fgetc(stream->src);
     }
     append_null_byte(token);
-    c = fgetc(stream->src);
+    // the ifs above do this
+    // c = fgetc(stream->src);
     if (c != EOF && !issymbolend(c)) {
         token_stream_push_error(stream, token,
-                                strdup("character literal too long"));
+                                strdup("character literal too long"),
+                                false);
         skip_while(stream, &issymbolend, true);
     } else {
         ungetc(c, stream->src);
@@ -281,7 +328,7 @@ static void next_number_or_symbol(TokenStream *stream, Token *token, char first_
             allow_plus_minus = true;
             append_char(token, c);
             continue;
-        } else if (c == 'e') {
+        } else if (base == 10 && c == 'e') {
             if (has_exp) {
                 token->type = TOKEN_TYPE_SYMBOL; 
                 ungetc(c, stream->src);
@@ -338,13 +385,30 @@ size_t token_stream_next(TokenStream *stream, Token *token) {
     } else if (nc == '\'') {
         token->type = TOKEN_TYPE_QUOTE;
         next_char(stream, token);
+    } else if (nc == '`') {
+        token->type = TOKEN_TYPE_BACKQUOTE;
+        next_char(stream, token);
+    } else if (nc == ',') {
+        // look at character after the m
+        char chars[2];
+        chars[0] = fgetc(stream->src);
+        chars[1] = fgetc(stream->src);
+        if (chars[1] == '@') {
+            token->type = TOKEN_TYPE_SPLICE;
+            copy_to_buffer(token, chars, 2);
+        } else {
+            ungetc(chars[1], stream->src);
+            token->type = TOKEN_TYPE_COMMA;
+            copy_to_buffer(token, chars, 1);
+        }
     } else if (nc == '"') {
         token->type = TOKEN_TYPE_STRING;
-        next_string(stream, token);            
+        next_string(stream, token);
     } else if (nc == '.') {
         // look at character after the .
         char chars[2];
-        fread(chars, 1, 2, stream->src);
+        chars[0] = fgetc(stream->src);
+        chars[1] = fgetc(stream->src);
         ungetc(chars[1], stream->src);
         if (isspace(chars[1])) {
             ++stream->col;
@@ -352,7 +416,7 @@ size_t token_stream_next(TokenStream *stream, Token *token) {
             copy_to_buffer(token, ".", 1);
         } else {
             // the . is part of something bigger
-            next_number_or_symbol(stream, token, chars[1]);
+            next_number_or_symbol(stream, token, chars[0]);
         }
     } else if (nc == '#') {
         token->type = TOKEN_TYPE_CHAR;
@@ -393,13 +457,6 @@ void parse_error_free(ParseError *error) {
     }
 }
 
-void read_native(FILE *src, LispObject ***result, size_t *result_len,
+bool token_stream_is_eof(TokenStream *stream) {
-                 ParseError *errors, size_t *error_count) {
+    return feof(stream->src);
-    TokenStream *stream = make_token_stream(src);
-    errors = stream->error_head;
-    stream->error_head = NULL;
-    stream->error_tail = NULL;
-    stream->error_count = 0;
-    *error_count = stream->error_count;
-    destroy_token_stream(stream);
 }

bootstrap/parse.h

@@ -1,13 +1,15 @@
+#ifndef INCLUDED_PARSE_H
+#define INCLUDED_PARSE_H
+
 #include <stdio.h>
 #include <stdbool.h>
 
-#include "lisp.h"
-
 typedef struct {
     size_t line;
     size_t col;
     char *context;
     char *desc;
+    bool at_end;
 
     void *next;
 } ParseError;
@@ -32,6 +34,9 @@ typedef enum {
     TOKEN_TYPE_SYMBOL,
     TOKEN_TYPE_PROPERTY,
     TOKEN_TYPE_QUOTE,
+    TOKEN_TYPE_BACKQUOTE,
+    TOKEN_TYPE_SPLICE,
+    TOKEN_TYPE_COMMA,
     TOKEN_TYPE_CHAR,
     TOKEN_TYPE_NUMBER,
     TOKEN_TYPE_STRING,
@@ -46,6 +51,8 @@ typedef struct {
     size_t col;
 } Token;
 
+const char *token_type_to_str(TokenType type) __attribute__((unused));
+
 // src is taken by this function
 TokenStream *make_token_stream(FILE *src);
 void destroy_token_stream(TokenStream *stream);
@@ -55,6 +62,6 @@ void token_free(Token *token);
 // return the number of errors left
 ParseError *token_stream_error(TokenStream *stream);
 void parse_error_free(ParseError *error);
+bool token_stream_is_eof(TokenStream *stream);
 
-void read_native(FILE *src, LispObject ***result, size_t *result_len,
+#endif
-                 ParseError *errors, size_t *error_count);

bootstrap/test.sl

@@ -0,0 +1 @@
+'('a `(,a '(,a)))

src/lisp.h

@@ -1,333 +0,0 @@
-#include <stddef.h>
-#include <stdbool.h>
-#include <stdint.h>
-#include <setjmp.h>
-
-typedef enum {
-    LISP_TYPE_NIL = 0, // only one value, nil (unit type)
-    LISP_TYPE_SYMBOL,
-    LISP_TYPE_CONS,
-    LISP_TYPE_STRING,
-    LISP_TYPE_ARRAY,
-    LISP_TYPE_INT,
-    LISP_TYPE_FLOAT,
-    LISP_TYPE_FUNCTION,
-    LISP_TYPE_CLASS,
-    LISP_TYPE_HASH_TABLE,
-    LISP_TYPE_INSTANCE,
-    LISP_TYPE_POINTER,
-    LISP_N_NATIVE_TYPES,
-} LispType;
-
-typedef struct {
-    LispType type;
-    bool persist;
-    size_t ref_count;
-} LispObject;
-
-typedef struct {
-    LispObject parent;
-    bool skip_free;
-    char *text;
-    size_t length;
-} LispString;
-
-typedef struct {
-    LispObject parent;
-    LispString *name;
-} LispSymbol;
-
-typedef struct {
-    LispObject parent;
-    LispObject *car;
-    LispObject *cdr;
-} LispCons;
-#define CONS(car, cdr) ((void *) call_native(Fcons, 2, (car), (cdr)))
-#define EMPTY_LIST ((LispCons *) Vnil)
-
-#define DOLIST(cvar, list, body) \
-    for (LispCons *__dolist_c = list; CONSP(__dolist_c); __dolist_c = (void *) \
-         __dolist_c->cdr) { \
-        LispObject * cvar = __dolist_c->car; \
-        body \
-    }
-
-typedef struct {
-    LispObject parent;
-    LispObject **data;
-    size_t length;
-} LispArray;
-
-#define DOARRAY(index, value, arr, body) \
-    for (size_t index = 0; index < (arr)->length; ++ index) { \
-        LispObject * value = (arr)->data[ index ]; \
-        body \
-    }
-
-typedef struct {
-    LispObject parent;
-    int64_t value;
-} LispInt;
-
-typedef struct {
-    LispObject parent;
-    double value;
-} LispFloat;
-
-
-
-typedef struct {
-    LispObject parent;
-    LispString *doc;
-    bool nativep;
-    bool macrop;
-    union {
-        struct {
-            LispObject *(*action)(size_t argc, LispObject **argv);
-            size_t nparg;
-            size_t noarg;
-            bool rargp;
-        } native;
-        struct {
-            LispObject *form;
-            LispArray *pargs; // list of position arguments
-            LispArray *oargs; // list of optional positional arguments
-            LispSymbol *rarg; // name of the rest argument
-        } lisp;
-    };
-} LispFunction;
-
-#define LISP_HASH_TABLE_INITIAL_SIZE 32
-
-struct LispHashTableBucket {
-    uint64_t hash;
-    LispObject *key;
-    LispObject *value;
-    struct LispHashTableBucket *next;
-    struct LispHashTableBucket *prev;
-};
-
-typedef struct {
-    LispObject parent;
-    size_t size;
-    size_t count;
-    struct LispHashTableBucket **data;
-    LispObject *hash_func;
-    LispObject *eq_func;
-} LispHashTable;
-
-#define DOHASH(kvar, vvar, table, body) \
-    for (size_t __dohash_i = 0; __dohash_i < (table)->size; ++__dohash_i) { \
-        struct LispHashTableBucket *__dohash_bucket = (table)->data[__dohash_i]; \
-        while (__dohash_bucket) { \
-            LispObject * kvar = __dohash_bucket->key; \
-            LispObject * vvar = __dohash_bucket->value; \
-            body \
-            __dohash_bucket = __dohash_bucket->next; \
-        } \
-    }
-
-typedef struct _LispClass {
-    LispObject parent;
-    struct _LispClass *superclass;
-    LispSymbol *name;
-    LispSymbol *module;
-    LispFunction *constructor;
-    LispHashTable *slots; // (name . index)
-    size_t high_slot;
-    LispHashTable *methods; // (name . function)
-} LispClass;
-
-typedef struct {
-    LispObject parent;
-    LispClass *class;
-    LispArray *slots;
-} LispInstance;
-
-typedef struct {
-    LispObject parent;
-    void *data;
-    void (*free_func)(void *);
-} LispPointer;
-
-extern LispObject *native_type_symbols[LISP_N_NATIVE_TYPES];
-extern LispSymbol *system_module;
-extern LispInstance *current_error;
-
-// Error classes
-extern LispClass *error_class;
-extern LispClass *type_error_class;
-extern LispClass *argument_error_class;
-extern LispClass *function_not_found_error_class;
-extern LispClass *class_slot_error_class;
-
-typedef struct {
-    LispString *file;
-    bool is_native;
-    size_t line;
-    size_t col;
-} StackFramePlace;
-
-typedef struct _StackFrame {
-    struct _StackFrame *up;
-    LispSymbol *block_name;
-    // (error class . int (to return from setjmp)) or nil
-    bool has_place;
-    StackFramePlace place;
-    LispHashTable *handlers; 
-    jmp_buf *jmp;
-    LispHashTable *locals;
-    LispCons *extras; // extra objects to be unrefed
-    LispCons *cleanup; // list of cleanup forms
-} StackFrame;
-
-extern StackFrame *call_stack;
-extern size_t call_stack_size;
-
-#define AS_OBJECT(obj) ((LispObject *) (obj))
-#define LISP_BOOL(obj) ((obj) ? Vt : Vnil)
-#define TYPE_OF(obj) (AS_OBJECT(obj)->type)
-#define COUNT_REFS(obj) (AS_OBJECT(obj)->ref_count)
-
-#define LISP_DEFVAR(name) LispObject * V ## name
-
-extern void *Vnil;
-extern LISP_DEFVAR(t); // symbol
-extern LISP_DEFVAR(module);
-extern LISP_DEFVAR(all_functions); // hash table (symbol . (symbol . function))
-extern LISP_DEFVAR(globals); // hash table (symbol . (symbol . any))
-extern LISP_DEFVAR(classes); // hash table (symbol . (symbol. class))
-
-void *ref_lisp_object(void *obj);
-void *unref_lisp_object(void *obj);
-void *lisp_check_type(LispType type, void *obj);
-LispObject *call_native(LispObject *(*func)(size_t argc, LispObject **argv),
-                        size_t argc, ...);
-LispString *make_lisp_string(const char *text, size_t length,
-                             bool skip_free);
-LispInt *make_lisp_int(int64_t value);
-LispFloat *make_lisp_float(double value);
-LispSymbol *make_lisp_symbol(const char *text, size_t length, bool skip_free);
-LispFunction *make_native_function(bool macrop, size_t nparg, size_t noarg, bool rargp,
-                                   LispObject *(*action)(size_t argc, LispObject **argv));
-LispObject *lookup_in_module(LispHashTable *table, LispSymbol *module,
-                             LispSymbol *name, bool include_system);
-void register_in_module(LispHashTable *table, LispSymbol *module,
-                        LispSymbol *name, LispObject *thing);
-LispArray *make_lisp_array(size_t size, LispObject **init_data);
-LispClass *make_lisp_class(LispSymbol *name, LispSymbol *module,
-                           LispClass *superclass, LispFunction *constructor,
-                           LispCons *slots);
-LispInstance *make_lisp_instance(LispClass *class, LispHashTable *slots);
-LispPointer *make_lisp_pointer(void *data, void(*free_func)(void *));
-void push_stack(LispSymbol *block_name, StackFramePlace *place, jmp_buf *jmp,
-                LispHashTable *handlers);
-void pop_stack(void);
-void add_auto_unref(void *obj);
-void dump_stack(LispInstance *error);
-void throw_error(LispInstance *error);
-LispClass *new_class(LispClass *superclass, LispSymbol *module,
-                     const char *name, bool skip_free, LispFunction *constructor,
-                     ...);
-LispInstance *new_instance(LispClass *class, ...);
-#define ERROR(...) throw_error(new_instance(__VA_ARGS__, NULL))
-#define TYPE_ERROR(exp, got) (ERROR(type_error_class, "expected", \
-                                    STRING_FROM_LITERAL(exp), "got", (got)))
-bool instanceof(LispInstance *instance, LispClass *class);
-size_t list_length(LispCons *list);
-
-#define INTERN_LITERAL(name) \
-    (AS_OBJECT(make_lisp_symbol(name, sizeof(name) - 1, true)))
-#define STRING_FROM_LITERAL(text) (make_lisp_string(text, sizeof(text) - 1, true))
-void init_lisp(void);
-void deinit_lisp(void);
-
-#define LISP_DEFUN(name) LispObject * F ## name (size_t argc, LispObject **argv)
-
-#define NILP(obj) (TYPE_OF(obj) == LISP_TYPE_NIL)
-
-#define SYMBOLP(obj) (TYPE_OF(obj) == LISP_TYPE_SYMBOL)
-#define AS_SYMBOL(obj) ((LispSymbol *) lisp_check_type(LISP_TYPE_SYMBOL, obj))
-LISP_DEFUN(symbolp);
-
-#define STRINGP(obj) (TYPE_OF(obj) == LISP_TYPE_STRING)
-#define AS_STRING(obj) ((LispString *) lisp_check_type(LISP_TYPE_STRING, obj))
-LISP_DEFUN(stringp);
-
-#define CONSP(obj) (TYPE_OF(obj) == LISP_TYPE_CONS)
-#define AS_CONS(obj) ((LispCons *) lisp_check_type(LISP_TYPE_CONS, obj))
-LISP_DEFUN(consp);
-
-#define ARRAYP(obj) (TYPE_OF(obj) == LISP_TYPE_ARRAY)
-#define AS_ARRAY(obj) ((LispArray *) lisp_check_type(LISP_TYPE_ARRAY, obj))
-LISP_DEFUN(arrayp);
-
-#define INTP(obj) (TYPE_OF(obj) == LISP_TYPE_INT)
-#define AS_INT(obj) ((LispInt *) lisp_check_type(LISP_TYPE_INT, obj))
-LISP_DEFUN(intp);
-
-#define FLOATP(obj) (TYPE_OF(obj) == LISP_TYPE_FLOAT)
-#define AS_FLOAT(obj) ((LispFloat *) lisp_check_type(LISP_TYPE_FLOAT, obj))
-LISP_DEFUN(floatp);
-
-#define FUNCTIONP(obj) (TYPE_OF(obj) == LISP_TYPE_FUNCTION)
-#define AS_FUNCTION(obj) ((LispFunction *) lisp_check_type(LISP_TYPE_FUNCTION, obj))
-LISP_DEFUN(functionp);
-
-#define HASH_TABLE_P(obj) (TYPE_OF(obj) == LISP_TYPE_HASH_TABLE)
-#define AS_HASH_TABLE(obj) ((LispHashTable *) lisp_check_type(LISP_TYPE_HASH_TABLE, obj))
-LISP_DEFUN(hash_table_p);
-
-#define CLASSP(obj) (TYPE_OF(obj) == LISP_TYPE_CLASS)
-#define AS_CLASS(obj) ((LispClass *) lisp_check_type(LISP_TYPE_CLASS, obj))
-LISP_DEFUN(classp);
-
-#define INSTANCEP(obj) (TYPE_OF(obj) == LISP_TYPE_INSTANCE)
-#define AS_INSTANCE(obj) ((LispInstance *) lisp_check_type(LISP_TYPE_INSTANCE, obj))
-LISP_DEFUN(instancep);
-
-#define POINTERP(obj) (TYPE_OF(obj) == LISP_TYPE_POINTER)
-#define AS_POINTER(obj) ((LispPointer *) lisp_check_type(LISP_TYPE_POINTER, obj))
-LISP_DEFUN(pointerp);
-
-// NOTE: this evaluates obj twice!!
-#define LISTP(obj) (NILP(obj) || CONSP(obj))
-LISP_DEFUN(listp);
-
-#define ATOM(obj) (!CONSP(obj))
-LISP_DEFUN(atom);
-
-#define NATIVE(obj) (!INSTANCEP(obj))
-LISP_DEFUN(native);
-
-LISP_DEFUN(type_of);
-#define TYPE_STR(obj) (((LispSymbol *) call_native(Ftype_of, 1, (obj)))->name)
-LISP_DEFUN(cons);
-LISP_DEFUN(list);
-LISP_DEFUN(length);
-LISP_DEFUN(intern);
-LISP_DEFUN(not);
-LISP_DEFUN(hash);
-LISP_DEFUN(make_hash_table);
-LISP_DEFUN(float);
-LISP_DEFUN(eq);
-LISP_DEFUN(gethash);
-LISP_DEFUN(puthash);
-LISP_DEFUN(remhash);
-LISP_DEFUN(symbol_function);
-LISP_DEFUN(funcall);
-LISP_DEFUN(apply);
-LISP_DEFUN(eval);
-LISP_DEFUN(make_instance);
-LISP_DEFUN(slot);
-LISP_DEFUN(setslot);
-LISP_DEFUN(array_to_list);
-LISP_DEFUN(list_to_array);
-LISP_DEFUN(superclassp);
-LISP_DEFUN(subclassp);
-LISP_DEFUN(hash_as_zero);
-
-// These are special forms, they their argument are NOT evaluated
-LISP_DEFUN(quote);
-LISP_DEFUN(and);
-LISP_DEFUN(or);

src/main.c

@@ -1,58 +0,0 @@
-#include <stdio.h>
-#include "parse.h"
-
-static const char *token_type_to_str(TokenType type) {
-    switch (type) {
-    case TOKEN_TYPE_EOF:
-        return "EOF";
-    case TOKEN_TYPE_COMMENT:
-        return "COMMENT";
-    case TOKEN_TYPE_PAREN:
-        return "PAREN";
-    case TOKEN_TYPE_BRACKET:
-        return "BRACKET";
-    case TOKEN_TYPE_SYMBOL:
-        return "SYMBOL";
-    case TOKEN_TYPE_QUOTE:
-        return "QUOTE";
-    case TOKEN_TYPE_NUMBER:
-        return "NUMBER";
-    case TOKEN_TYPE_CHAR:
-        return "CHAR";
-    case TOKEN_TYPE_STRING:
-        return "STRING";
-    default:
-        return "UNKNOWN";
-    }
-}
-
-int main(int argc, const char **argv) {
-    init_lisp();
-    LispObject *msg_slot = ref_lisp_object(INTERN_LITERAL("message"));
-    jmp_buf jmp;
-    int branch = setjmp(jmp);
-    if (!branch) {
-        LispHashTable *handlers = (void *) call_native(Fmake_hash_table, 2, Vnil, Vnil);
-        call_native(Fputhash, 3, handlers, type_error_class, make_lisp_int(1));
-        call_native(Fputhash, 3, handlers, class_slot_error_class, make_lisp_int(2));
-        StackFramePlace err_place = {
-            .file = STRING_FROM_LITERAL(__FILE__),
-            .is_native = true,
-            .line = __LINE__ - 3,
-            .col = 8,
-        };
-        push_stack((void *) INTERN_LITERAL(__FUNCTION__), &err_place, &jmp, handlers);
-        unref_lisp_object(handlers);
-        AS_STRING(Vnil);
-    } else if (branch == 1) {
-        LispString *msg = (void *) call_native(Fslot, 2, current_error, msg_slot);
-        printf("Caught %s: %*s\n",
-               current_error->class->name->name->text,
-               (int) msg->length, msg->text);
-        dump_stack(current_error);
-    }
-    unref_lisp_object(msg_slot);
-    pop_stack();
-    deinit_lisp();
-    return 0;
-}