lumbda/c/reader.c

/*
 * reader.c — Tokenizer + parser for Scheme source
 */
#include "lumbda.h"

/* ═══════════════════════════════════════════════════════════════════════════
 * Tokenizer
 * ═══════════════════════════════════════════════════════════════════════════ */

static void tl_init(TokenList *tl) {
    tl->cap = 256;
    tl->count = 0;
    tl->tokens = (char **)ul_malloc(sizeof(char *) * tl->cap);
    tl->lines = (int *)ul_malloc(sizeof(int) * tl->cap);
}

static void tl_push(TokenList *tl, const char *tok, int len, int line) {
    if (tl->count >= tl->cap) {
        tl->cap *= 2;
        tl->tokens = (char **)ul_realloc(tl->tokens, sizeof(char *) * tl->cap);
        tl->lines = (int *)ul_realloc(tl->lines, sizeof(int) * tl->cap);
    }
    char *copy = (char *)ul_malloc(len + 1);
    memcpy(copy, tok, len);
    copy[len] = '\0';
    tl->tokens[tl->count] = copy;
    tl->lines[tl->count] = line;
    tl->count++;
}

static int is_delimiter(int c) {
    return c == '\0' || c == '(' || c == ')' || c == '"' || c == '\'' ||
           c == '`' || c == ',' || c == ';' || isspace(c);
}

void tokenize(const char *src, TokenList *out, bool track_lines) {
    tl_init(out);
    const char *p = src;
    int line = 1;

    while (*p) {
        /* Skip whitespace */
        while (*p && isspace(*p)) {
            if (*p == '\n') line++;
            p++;
        }
        if (!*p) break;

        /* Line comment */
        if (*p == ';') {
            while (*p && *p != '\n') p++;
            continue;
        }

        /* Block comment #| ... |# */
        if (*p == '#' && *(p+1) == '|') {
            p += 2;
            int depth = 1;
            while (*p && depth > 0) {
                if (*p == '#' && *(p+1) == '|') { depth++; p += 2; }
                else if (*p == '|' && *(p+1) == '#') { depth--; p += 2; }
                else { if (*p == '\n') line++; p++; }
            }
            continue;
        }

        /* Datum comment #; */
        if (*p == '#' && *(p+1) == ';') {
            p += 2;
            /* Skip whitespace before datum */
            while (*p && isspace(*p)) { if (*p == '\n') line++; p++; }
            /* We need to skip exactly one datum — use a recursive approach */
            /* For now, count balanced parens */
            if (*p == '(') {
                int depth = 0;
                do {
                    if (*p == '(') depth++;
                    else if (*p == ')') depth--;
                    if (*p == '"') { p++; while (*p && (*p != '"' || *(p-1) == '\\')) p++; if (*p) p++; continue; }
                    if (*p == '\n') line++;
                    p++;
                } while (*p && depth > 0);
            } else if (*p == '"') {
                p++; while (*p && (*p != '"' || *(p-1) == '\\')) p++; if (*p) p++;
            } else {
                while (*p && !is_delimiter(*p)) p++;
            }
            continue;
        }

        int tok_line = line;

        /* String literal */
        if (*p == '"') {
            const char *start = p;
            p++; /* skip opening " */
            while (*p && *p != '"') {
                if (*p == '\\' && *(p+1)) { p += 2; continue; }
                if (*p == '\n') line++;
                p++;
            }
            if (*p == '"') p++; /* skip closing " */
            tl_push(out, start, (int)(p - start), tok_line);
            continue;
        }

        /* Single-char tokens */
        if (*p == '(' || *p == ')') {
            tl_push(out, p, 1, tok_line);
            p++;
            continue;
        }
        if (*p == '\'') { tl_push(out, p, 1, tok_line); p++; continue; }
        if (*p == '`') { tl_push(out, p, 1, tok_line); p++; continue; }

        /* ,@ (unquote-splicing) */
        if (*p == ',' && *(p+1) == '@') {
            tl_push(out, p, 2, tok_line);
            p += 2;
            continue;
        }
        if (*p == ',') { tl_push(out, p, 1, tok_line); p++; continue; }

        /* #( vector literal */
        if (*p == '#' && *(p+1) == '(') {
            tl_push(out, p, 2, tok_line);
            p += 2;
            continue;
        }

        /* Boolean #t #f */
        if (*p == '#' && (*(p+1) == 't' || *(p+1) == 'T' || *(p+1) == 'f' || *(p+1) == 'F')) {
            if (is_delimiter(*(p+2))) {
                tl_push(out, p, 2, tok_line);
                p += 2;
                continue;
            }
            /* #true / #false */
            if ((*(p+1) == 't' || *(p+1) == 'T') && strncmp(p, "#true", 5) == 0 && is_delimiter(*(p+5))) {
                tl_push(out, "#t", 2, tok_line); p += 5; continue;
            }
            if ((*(p+1) == 'f' || *(p+1) == 'F') && strncmp(p, "#false", 6) == 0 && is_delimiter(*(p+6))) {
                tl_push(out, "#f", 2, tok_line); p += 6; continue;
            }
        }

        /* Character #\ */
        if (*p == '#' && *(p+1) == '\\') {
            const char *start = p;
            p += 2;
            /* Named chars */
            const char *names[] = {"space", "newline", "tab", "return", "null", "escape", NULL};
            bool found = false;
            for (int i = 0; names[i]; i++) {
                size_t nlen = strlen(names[i]);
                if (strncasecmp(p, names[i], nlen) == 0 && is_delimiter(*(p + nlen))) {
                    p += nlen;
                    tl_push(out, start, (int)(p - start), tok_line);
                    found = true;
                    break;
                }
            }
            if (!found) {
                /* Single char */
                if (*p) p++;
                tl_push(out, start, (int)(p - start), tok_line);
            }
            continue;
        }

        /* Atom (number, symbol, etc.) */
        const char *start = p;
        while (*p && !is_delimiter(*p)) p++;
        if (p > start) {
            tl_push(out, start, (int)(p - start), tok_line);
        }
    }
}

/* ═══════════════════════════════════════════════════════════════════════════
 * Parser
 * ═══════════════════════════════════════════════════════════════════════════ */

static char *unescape_string(const char *s, size_t len) {
    /* s includes quotes: "..." */
    char *buf = (char *)ul_malloc(len + 1);
    int j = 0;
    for (size_t i = 1; i < len - 1; i++) {
        if (s[i] == '\\' && i + 1 < len - 1) {
            i++;
            switch (s[i]) {
                case 'n': buf[j++] = '\n'; break;
                case 't': buf[j++] = '\t'; break;
                case 'r': buf[j++] = '\r'; break;
                case '"': buf[j++] = '"'; break;
                case '\\': buf[j++] = '\\'; break;
                default: buf[j++] = '\\'; buf[j++] = s[i]; break;
            }
        } else {
            buf[j++] = s[i];
        }
    }
    buf[j] = '\0';
    return buf;
}

Value parse_atom(const char *tok) {
    /* Booleans */
    if (strcmp(tok, "#t") == 0 || strcmp(tok, "#T") == 0) return VAL_TRUE;
    if (strcmp(tok, "#f") == 0 || strcmp(tok, "#F") == 0) return VAL_FALSE;

    /* Character */
    if (tok[0] == '#' && tok[1] == '\\') {
        const char *name = tok + 2;
        if (strcasecmp(name, "space") == 0) return VAL_CHAR(' ');
        if (strcasecmp(name, "newline") == 0) return VAL_CHAR('\n');
        if (strcasecmp(name, "tab") == 0) return VAL_CHAR('\t');
        if (strcasecmp(name, "return") == 0) return VAL_CHAR('\r');
        if (strcasecmp(name, "null") == 0) return VAL_CHAR('\0');
        if (strcasecmp(name, "escape") == 0) return VAL_CHAR('\x1b');
        return VAL_CHAR(name[0]);
    }

    /* String */
    if (tok[0] == '"') {
        size_t len = strlen(tok);
        char *unescaped = unescape_string(tok, len);
        Value v = make_string(unescaped, strlen(unescaped), false);
        ul_free(unescaped);
        return v;
    }

    /* Integer */
    {
        char *end;
        errno = 0;
        long long val = strtoll(tok, &end, 10);
        if (*end == '\0' && errno == 0) {
            /* Check if fits in 48-bit int */
            if (val >= -(1LL << 47) && val < (1LL << 47))
                return VAL_INT(val);
            else
                return make_double((double)val);
        }
    }

    /* Float */
    {
        char *end;
        errno = 0;
        double val = strtod(tok, &end);
        if (*end == '\0' && errno == 0) {
            return make_double(val);
        }
    }

    /* Special float literals */
    if (strcmp(tok, "+inf.0") == 0) return make_double(INFINITY);
    if (strcmp(tok, "-inf.0") == 0) return make_double(-INFINITY);
    if (strcmp(tok, "+nan.0") == 0 || strcmp(tok, "-nan.0") == 0) return make_double(NAN);

    /* Rational n/d */
    {
        const char *slash = strchr(tok, '/');
        if (slash && slash != tok && *(slash+1) != '\0') {
            /* Check if it's a valid rational: digits/digits */
            bool valid = true;
            const char *p = tok;
            if (*p == '-') p++;
            while (p < slash) { if (!isdigit(*p)) { valid = false; break; } p++; }
            p = slash + 1;
            if (*p == '-') p++;
            while (*p) { if (!isdigit(*p)) { valid = false; break; } p++; }
            if (valid) {
                int64_t num = strtoll(tok, NULL, 10);
                int64_t den = strtoll(slash + 1, NULL, 10);
                if (den != 0) return rational_normalize(num, den);
            }
        }
    }

    /* Symbol */
    return intern(tok);
}

Value parse_one(TokenList *tl, int *pos) {
    if (*pos >= tl->count) lisp_error("unexpected EOF");
    char *tok = tl->tokens[*pos];
    int line = tl->lines[*pos];
    (*pos)++;

    /* Quote abbreviations */
    if (strcmp(tok, "'") == 0) {
        Value v = parse_one(tl, pos);
        Pair *p = make_pair(SYM_QUOTE, cons(v, VAL_NIL));
        p->line = line;
        return VAL_PTR(p);
    }
    if (strcmp(tok, "`") == 0) {
        Value v = parse_one(tl, pos);
        Pair *p = make_pair(SYM_QUASIQUOTE, cons(v, VAL_NIL));
        p->line = line;
        return VAL_PTR(p);
    }
    if (strcmp(tok, ",") == 0) {
        Value v = parse_one(tl, pos);
        Pair *p = make_pair(SYM_UNQUOTE, cons(v, VAL_NIL));
        p->line = line;
        return VAL_PTR(p);
    }
    if (strcmp(tok, ",@") == 0) {
        Value v = parse_one(tl, pos);
        Pair *p = make_pair(SYM_UNQUOTE_SPLICING, cons(v, VAL_NIL));
        p->line = line;
        return VAL_PTR(p);
    }

    /* List */
    if (strcmp(tok, "(") == 0) {
        /* Collect items */
        Value items[4096];
        int count = 0;
        Value tail = VAL_NIL;
        bool has_dot = false;

        while (1) {
            if (*pos >= tl->count) lisp_error("unclosed (");
            char *t = tl->tokens[*pos];
            if (strcmp(t, ")") == 0) { (*pos)++; break; }
            if (strcmp(t, ".") == 0) {
                (*pos)++;
                tail = parse_one(tl, pos);
                has_dot = true;
                if (*pos >= tl->count || strcmp(tl->tokens[*pos], ")") != 0)
                    lisp_error(". without )");
                (*pos)++;
                break;
            }
            if (count >= 4096) lisp_error("list too long");
            items[count++] = parse_one(tl, pos);
        }

        Value r = has_dot ? tail : VAL_NIL;
        for (int i = count - 1; i >= 0; i--) {
            r = cons(items[i], r);
        }
        if (IS_PAIR(r)) AS_PAIR(r)->line = line;
        return r;
    }

    /* Vector literal #( */
    if (strcmp(tok, "#(") == 0) {
        Value items[4096];
        int count = 0;
        while (1) {
            if (*pos >= tl->count) lisp_error("unclosed #(");
            if (strcmp(tl->tokens[*pos], ")") == 0) { (*pos)++; break; }
            if (count >= 4096) lisp_error("vector too long");
            items[count++] = parse_one(tl, pos);
        }
        return make_vector_from(items, count);
    }

    if (strcmp(tok, ")") == 0) lisp_error("unexpected )");

    return parse_atom(tok);
}

Value *read_all(const char *src, int *count, bool track_lines) {
    TokenList tl;
    tokenize(src, &tl, track_lines);

    int cap = 64;
    Value *exprs = (Value *)ul_malloc(sizeof(Value) * cap);
    *count = 0;
    int pos = 0;

    while (pos < tl.count) {
        if (*count >= cap) {
            cap *= 2;
            exprs = (Value *)ul_realloc(exprs, sizeof(Value) * cap);
        }
        exprs[*count] = parse_one(&tl, &pos);
        (*count)++;
    }

    /* Free token list */
    for (int i = 0; i < tl.count; i++) ul_free(tl.tokens[i]);
    ul_free(tl.tokens);
    ul_free(tl.lines);

    return exprs;
}