/*
 * eval.c — Tree-walking evaluator with TCO via explicit loop
 *
 * Port of the Python leval() function with full special form support.
 */
#include "lumbda.h"
#include "jit.h"

/* ═══════════════════════════════════════════════════════════════════════════
 * call/cc support — thread-local escape state
 *
 * MOAD-0002: These thread-locals are intentional coupling, required by the
 * setjmp/longjmp escape-only call/cc implementation. The continuation closure
 * (ul_callcc_kont) writes cc_escape_val and longjmps to cc_active_jmp; the
 * setjmp site in eval reads them back. Threading these through every call
 * frame would defeat the purpose of longjmp-based unwinding. Thread-local
 * storage ensures thread safety without a context parameter.
 * ═══════════════════════════════════════════════════════════════════════════ */

static __thread Value cc_escape_val;
static __thread jmp_buf *cc_active_jmp;

static Value ul_callcc_kont(Value *args, int nargs, Env *env) {
    (void)env;
    cc_escape_val = (nargs > 0) ? args[0] : VAL_VOID;
    if (cc_active_jmp) longjmp(*cc_active_jmp, 1);
    lisp_error("continuation invoked outside call/cc");
    return VAL_VOID; /* unreachable */
}

/* ═══════════════════════════════════════════════════════════════════════════
 * Helpers
 * ═══════════════════════════════════════════════════════════════════════════ */

/* Lisp list → C array. Returns count. Caller must free *out. */
int value_to_list(Value v, Value **out) {
    if (IS_NIL(v)) { *out = NULL; return 0; }
    /* Count */
    int n = 0;
    Value cur = v;
    while (IS_PAIR(cur)) { n++; cur = CDR(cur); }
    if (!IS_NIL(cur)) lisp_error("not a list");

    *out = (Value *)ul_malloc(sizeof(Value) * n);
    cur = v;
    for (int i = 0; i < n; i++) {
        (*out)[i] = CAR(cur);
        cur = CDR(cur);
    }
    return n;
}

/* C array → Lisp list */
Value list_to_value(Value *items, int count) {
    Value r = VAL_NIL;
    for (int i = count - 1; i >= 0; i--) {
        r = cons(items[i], r);
    }
    return r;
}

/* Parse lambda formals */
Formals parse_formals(Value f) {
    Formals result;
    result.params = NULL;
    result.nparams = 0;
    result.rest = VAL_NIL;

    if (IS_SYM(f)) {
        /* (lambda x body) — all args as rest */
        result.rest = f;
        return result;
    }
    if (IS_NIL(f)) return result;

    /* Count params */
    int n = 0;
    Value cur = f;
    while (IS_PAIR(cur)) { n++; cur = CDR(cur); }
    bool has_rest = !IS_NIL(cur);

    result.nparams = n;
    result.params = (Value *)ul_malloc(sizeof(Value) * n);
    cur = f;
    for (int i = 0; i < n; i++) {
        if (!IS_SYM(CAR(cur)))
            lisp_error("param must be symbol");
        result.params[i] = CAR(cur);
        cur = CDR(cur);
    }
    if (has_rest) {
        if (!IS_SYM(cur))
            lisp_error("rest param must be symbol");
        result.rest = cur;
    }
    return result;
}

bool has_internal_defines(ExprList body) {
    if (body.count == 0) return false;
    Value first = body.exprs[0];
    if (!IS_PAIR(first)) return false;
    Value head = CAR(first);
    return head == SYM_DEFINE || head == SYM_BEGIN;
}

/* Scan internal defines and pre-declare all names as VOID */
ExprList body_with_env(Value *forms, int count, Env *env) {
    if (count == 0) {
        ExprList r = {NULL, 0};
        return r;
    }

    /* We may need to splice begin forms */
    int cap = count + 64;
    Value *expanded = (Value *)ul_malloc(sizeof(Value) * cap);
    memcpy(expanded, forms, sizeof(Value) * count);
    int n = count;

    int i = 0;
    while (i < n) {
        Value f = expanded[i];
        if (IS_PAIR(f) && CAR(f) == SYM_DEFINE) {
            Value *a; int na = value_to_list(CDR(f), &a);
            Value name;
            if (IS_PAIR(a[0])) name = CAR(a[0]);
            else name = a[0];
            if (IS_SYM(name)) env_define(env, name, VAL_VOID);
            ul_free(a);
            i++;
        } else if (IS_PAIR(f) && CAR(f) == SYM_BEGIN) {
            /* Splice */
            Value *spliced; int ns = value_to_list(CDR(f), &spliced);
            if (n + ns - 1 >= cap) {
                cap = (n + ns) * 2;
                expanded = (Value *)ul_realloc(expanded, sizeof(Value) * cap);
            }
            memmove(expanded + i + ns, expanded + i + 1, sizeof(Value) * (n - i - 1));
            memcpy(expanded + i, spliced, sizeof(Value) * ns);
            n = n + ns - 1;
            ul_free(spliced);
            /* Don't increment i — re-check the first spliced form */
        } else {
            break;
        }
    }

    ExprList r;
    r.exprs = expanded;
    r.count = n;
    return r;
}

bool is_proper_list(Value v) {
    Value slow = v, fast = v;
    while (1) {
        if (IS_NIL(fast)) return true;
        if (!IS_PAIR(fast)) return false;
        fast = CDR(fast);
        if (IS_NIL(fast)) return true;
        if (!IS_PAIR(fast)) return false;
        fast = CDR(fast);
        slow = CDR(slow);
        if (fast == slow) return false; /* cycle */
    }
}

bool values_equal(Value a, Value b) {
    if (a == b) return true;
    /* Both numbers */
    if (is_number(a) && is_number(b)) return num_eq(a, b);
    /* Both strings */
    if (IS_STRING(a) && IS_STRING(b)) {
        ULString *sa = AS_STRING(a), *sb = AS_STRING(b);
        return sa->len == sb->len && memcmp(sa->data, sb->data, sa->len) == 0;
    }
    /* Both pairs — deep comparison */
    if (IS_PAIR(a) && IS_PAIR(b)) {
        return values_equal(CAR(a), CAR(b)) && values_equal(CDR(a), CDR(b));
    }
    /* Both vectors */
    if (IS_VECTOR(a) && IS_VECTOR(b)) {
        ULVector *va = AS_VECTOR(a), *vb = AS_VECTOR(b);
        if (va->len != vb->len) return false;
        for (size_t i = 0; i < va->len; i++) {
            if (!values_equal(va->data[i], vb->data[i])) return false;
        }
        return true;
    }
    /* Chars */
    if (IS_CHAR(a) && IS_CHAR(b)) return AS_CHAR(a) == AS_CHAR(b);
    return false;
}

/* ═══════════════════════════════════════════════════════════════════════════
 * Quasiquote expander
 * ═══════════════════════════════════════════════════════════════════════════ */

Value qq_expand(Value tmpl, Env *env, int depth) {
    if (!IS_PAIR(tmpl)) return tmpl;

    if (CAR(tmpl) == SYM_QUASIQUOTE) {
        return cons(SYM_QUASIQUOTE,
                    cons(qq_expand(CADR(tmpl), env, depth + 1), VAL_NIL));
    }
    if (CAR(tmpl) == SYM_UNQUOTE) {
        if (depth == 0) return leval(CADR(tmpl), env);
        return cons(SYM_UNQUOTE,
                    cons(qq_expand(CADR(tmpl), env, depth - 1), VAL_NIL));
    }

    /* Collect parts */
    int cap = 64;
    Value *parts = (Value *)ul_malloc(sizeof(Value) * cap);
    int nparts = 0;
    Value n = tmpl;

    while (IS_PAIR(n)) {
        Value item = CAR(n);
        if (IS_PAIR(item) && CAR(item) == SYM_UNQUOTE_SPLICING) {
            if (depth == 0) {
                Value spliced = leval(CADR(item), env);
                Value *items; int ni = value_to_list(spliced, &items);
                for (int i = 0; i < ni; i++) {
                    if (nparts >= cap) { cap *= 2; parts = (Value *)ul_realloc(parts, sizeof(Value) * cap); }
                    parts[nparts++] = items[i];
                }
                ul_free(items);
            } else {
                if (nparts >= cap) { cap *= 2; parts = (Value *)ul_realloc(parts, sizeof(Value) * cap); }
                parts[nparts++] = cons(SYM_UNQUOTE_SPLICING,
                                       cons(qq_expand(CADR(item), env, depth - 1), VAL_NIL));
            }
        } else {
            if (nparts >= cap) { cap *= 2; parts = (Value *)ul_realloc(parts, sizeof(Value) * cap); }
            parts[nparts++] = qq_expand(item, env, depth);
        }
        n = CDR(n);
    }

    Value tail = IS_NIL(n) ? VAL_NIL : qq_expand(n, env, depth);
    Value r = tail;
    for (int i = nparts - 1; i >= 0; i--) {
        r = cons(parts[i], r);
    }
    ul_free(parts);
    return r;
}

/* ═══════════════════════════════════════════════════════════════════════════
 * call_proc — Non-tail recursive call (for use inside builtins)
 * ═══════════════════════════════════════════════════════════════════════════ */

Value call_proc(Value proc, Value *args, int nargs, Env *env) {
    if (IS_BUILTIN(proc)) {
        return AS_BUILTIN(proc)(args, nargs, env);
    }
    if (IS_PROC(proc)) {
        Proc *p = AS_PROC(proc);

        /* JIT path: try to compile and cache native code */
        if (g_jit_enabled && p->jit_block == NULL && nargs <= 6) {
            JitBlock *jb = jit_compile(p);
            p->jit_block = jb ? (void *)jb : (void *)(uintptr_t)1;
        }
        if (p->jit_block && p->jit_block != (void *)(uintptr_t)1) {
            JitBlock *jb = (JitBlock *)p->jit_block;
            Value pad[6] = {0};
            for (int i = 0; i < nargs && i < 6; i++) pad[i] = args[i];
            return jb->func(pad[0], pad[1], pad[2], pad[3], pad[4], pad[5]);
        }

        Env *c = env_child(p->env, p->params, p->nparams, p->rest, args, nargs);
        ExprList body;
        if (p->has_defs) {
            body = body_with_env(p->body.exprs, p->body.count, c);
        } else {
            body = p->body;
        }
        for (int i = 0; i < body.count - 1; i++) leval(body.exprs[i], c);
        return leval(body.exprs[body.count - 1], c);
    }
    if (IS_COMPILED_PROC(proc)) {
        CompiledProc *cp = AS_COMPILED_PROC(proc);
        Env *c = env_child(cp->env, cp->params, cp->nparams, cp->rest, args, nargs);
        return vm_exec(cp->code, c);
    }
    if (IS_CONTINUATION(proc)) {
        /* Invoke the continuation via the VM trampoline */
        FullCont *cont = AS_CONTINUATION(proc);
        Value val = (nargs > 0) ? args[0] : VAL_VOID;
        if (!g_cont_trampoline || !g_cont_trampoline->active) {
            lisp_error("continuation invoked outside VM execution");
        }
        g_cont_invoked = cont;
        g_cont_invoked_val = val;
        longjmp(g_cont_trampoline->jmp, 1);
    }
    lisp_error("not callable: %s", show(proc, false));
    return VAL_NIL;
}

/* ═══════════════════════════════════════════════════════════════════════════
 * define-record-type
 * ═══════════════════════════════════════════════════════════════════════════ */

static Value define_record_type(Value *a, int na, Env *env) {
    Value name = a[0];
    int ri = 1;

    /* Check for (inherit parent) */
    const char *parent_name = NULL;
    if (ri < na && IS_PAIR(a[ri]) && CAR(a[ri]) == intern("inherit")) {
        Value *inh; int ninh = value_to_list(a[ri], &inh);
        parent_name = sym_name(inh[1]);
        ul_free(inh);
        ri++;
    }

    /* Constructor spec */
    Value *ctor_spec; int nctor = value_to_list(a[ri], &ctor_spec);
    Value ctor_name = ctor_spec[0];
    char **all_fields = (char **)ul_malloc(sizeof(char *) * (nctor - 1));
    int nfields = nctor - 1;
    for (int i = 0; i < nfields; i++) {
        all_fields[i] = ul_strdup(sym_name(ctor_spec[i + 1]));
    }
    ri++;

    /* Predicate */
    Value pred_name = a[ri++];

    /* Register type */
    register_record_type(sym_name(name), all_fields, nfields, parent_name);

    /* Constructor: builds (name field1 field2 ...) */
    /* We create a builtin closure */
    {
        /* Capture field count and name symbol */
        const char *type_tag = sym_name(name);
        int nf = nfields;
        Value *field_syms = (Value *)ul_malloc(sizeof(Value) * nf);
        for (int i = 0; i < nf; i++) field_syms[i] = ctor_spec[i + 1];

        /* Create a Proc that builds (list 'type-name f1 f2 ...) */
        /* For simplicity, we'll use a builtin */
        /* But builtins can't capture — we'll use the type tag in the env */
        /* Actually, let's just define a Proc that builds the list */
        ExprList body;
        body.count = 1;
        body.exprs = (Value *)ul_malloc(sizeof(Value));

        /* Build: (list (quote name) f1 f2 ...) */
        Value *listargs = (Value *)ul_malloc(sizeof(Value) * (nf + 2));
        listargs[0] = intern("list");
        listargs[1] = cons(SYM_QUOTE, cons(name, VAL_NIL));
        for (int i = 0; i < nf; i++) listargs[2 + i] = field_syms[i];
        body.exprs[0] = list_to_value(listargs, nf + 2);
        ul_free(listargs);

        Proc *ctor = make_proc(field_syms, nf, VAL_NIL, body, env, sym_name(ctor_name));
        Value ctor_val = VAL_PTR(ctor);
        if (g_auto_compile) {
            TRY(ctx) {
                CompiledProc *cp = compile_proc(ctor, env);
                ctor_val = VAL_PTR(cp);
            } CATCH {
                /* ignore compile failure */
            } ENDTRY;
        }
        env_define(env, ctor_name, ctor_val);
        ul_free(field_syms);
    }

    /* Predicate: check if instance's type tag matches */
    {
        const char *type_str = sym_name(name);
        /* Create a builtin that captures type_str */
        /* We need a closure, but builtins are just function pointers.
           We'll store the type name in a small env trick. */
        /* Actually for simplicity, we'll create a Proc with the right body */
        Value arg_sym = intern("x");
        ExprList body;
        body.count = 1;
        body.exprs = (Value *)ul_malloc(sizeof(Value));
        /* Build: (and (pair? x) (symbol? (car x)) (eq? (car x) 'name)) */
        /* Simpler: use a special check that understands subtypes */
        /* We'll need a native predicate. Let's put the type name in an env binding. */
        Value type_sym = intern("__record_type_tag__");
        Env *pred_env = make_env(env);
        env_define(pred_env, type_sym, cons(SYM_QUOTE, cons(name, VAL_NIL)));

        /* (and (pair? x) (symbol? (car x))
               ... some way to check subtypes ...) */
        /* For now, build a simple check */
        body.exprs[0] = cons(intern("__record-pred?__"),
                             cons(arg_sym, cons(cons(SYM_QUOTE, cons(name, VAL_NIL)), VAL_NIL)));

        Proc *pred = make_proc(&arg_sym, 1, VAL_NIL, body, env, sym_name(pred_name));
        /* Actually, this is getting complicated. Let's just register a builtin. */
        /* We'll use a different approach: store a lambda closure that checks. */
        /* Simplest: use a parameter-carrying closure via env */
        (void)pred; /* discard */

        /* Create the body as Scheme source */
        char src[256];
        snprintf(src, sizeof(src),
            "(lambda (x) (and (pair? x) (symbol? (car x)) (__is-subtype?__ (symbol->string (car x)) \"%s\")))",
            type_str);
        int nc;
        Value *exprs = read_all(src, &nc, false);
        Value pred_val = leval(exprs[0], env);
        env_define(env, pred_name, pred_val);
        ul_free(exprs);
    }

    /* Accessors and mutators */
    for (int i = ri; i < na; i++) {
        Value *spec; int nspec = value_to_list(a[i], &spec);
        if (nspec < 2) { ul_free(spec); continue; }

        Value field_tag = spec[0];
        Value getter_name = spec[1];
        Value setter_name = nspec > 2 ? spec[2] : VAL_NIL;

        /* Find field index */
        int idx = -1;
        const char *field_str = sym_name(field_tag);
        for (int j = 0; j < nfields; j++) {
            if (strcmp(all_fields[j], field_str) == 0) { idx = j + 1; break; } /* +1 for type tag */
        }
        if (idx < 0) lisp_error("define-record-type %s: field '%s' not found",
                                  sym_name(name), field_str);

        /* Getter: (lambda (x) (list-ref x idx)) */
        {
            char src[128];
            snprintf(src, sizeof(src), "(lambda (x) (list-ref x %d))", idx);
            int nc;
            Value *exprs = read_all(src, &nc, false);
            env_define(env, getter_name, leval(exprs[0], env));
            ul_free(exprs);
        }

        /* Setter */
        if (!IS_NIL(setter_name)) {
            char src[128];
            snprintf(src, sizeof(src), "(lambda (x v) (list-set! x %d v))", idx);
            int nc;
            Value *exprs = read_all(src, &nc, false);
            env_define(env, setter_name, leval(exprs[0], env));
            ul_free(exprs);
        }

        ul_free(spec);
    }

    for (int i = 0; i < nfields; i++) ul_free(all_fields[i]);
    ul_free(all_fields);
    ul_free(ctor_spec);

    return VAL_VOID;
}

/* ═══════════════════════════════════════════════════════════════════════════
 * Syntax-rules transformer
 * ═══════════════════════════════════════════════════════════════════════════ */

/* Forward declarations for syntax-rules */
static bool sr_match(SyntaxTransformer *st, Value pat, Value form, Env *bindings);
static Value sr_expand(SyntaxTransformer *st, Value tmpl, Env *bindings);

static bool is_literal(SyntaxTransformer *st, const char *name) {
    for (int i = 0; i < st->nliterals; i++) {
        if (strcmp(st->literals[i], name) == 0) return true;
    }
    return false;
}

static bool sr_match(SyntaxTransformer *st, Value pat, Value form, Env *bindings) {
    if (IS_NIL(pat)) return IS_NIL(form);
    if (pat == VAL_TRUE || pat == VAL_FALSE) return pat == form;
    if (IS_INT(pat) || IS_DOUBLE(pat)) return values_equal(pat, form);

    if (IS_SYM(pat)) {
        const char *pname = sym_name(pat);
        if (is_literal(st, pname)) {
            return IS_SYM(form) && strcmp(sym_name(form), pname) == 0;
        }
        if (pat == SYM_UNDERSCORE) return true;
        env_define(bindings, pat, form);
        return true;
    }

    if (!IS_PAIR(pat)) return values_equal(pat, form);

    /* Check for ellipsis: (sub_pat ... . rest_pat) */
    if (IS_PAIR(CDR(pat)) && CADR(pat) == SYM_ELLIPSIS) {
        Value sub_pat = CAR(pat);
        Value rest_pat = CDDR(pat);

        /* Count required tail elements */
        int n_rest = 0;
        Value rp = rest_pat;
        while (IS_PAIR(rp)) { n_rest++; rp = CDR(rp); }

        /* Collect form items */
        Value *items; int nitems = 0;
        if (IS_PAIR(form)) {
            nitems = value_to_list(form, &items);
        } else if (IS_NIL(form)) {
            items = NULL;
        } else {
            return false;
        }

        int n_ell = nitems - n_rest;
        if (n_ell < 0) { ul_free(items); return false; }

        /* Create ellipsis binding env (using vectors to hold lists) */
        /* For each pattern var in sub_pat, accumulate matches */
        for (int i = 0; i < n_ell; i++) {
            Env *ib = make_env(NULL);
            if (!sr_match(st, sub_pat, items[i], ib)) {
                ul_free(items); return false;
            }
            /* Merge ib bindings into bindings as vectors */
            for (size_t b = 0; b < ib->nbuckets; b++) {
                EnvBinding *bind = ib->buckets[b];
                while (bind) {
                    /* Accumulate: existing vector or create new one */
                    EnvBinding *existing = NULL;
                    uint32_t h = (uint32_t)((GET_PAYLOAD(bind->sym) * 2654435761ULL) % bindings->nbuckets);
                    EnvBinding *eb = bindings->buckets[h];
                    while (eb) {
                        if (eb->sym == bind->sym) { existing = eb; break; }
                        eb = eb->next;
                    }
                    if (existing && IS_VECTOR(existing->val)) {
                        /* Append to vector */
                        ULVector *vec = AS_VECTOR(existing->val);
                        if (vec->len >= vec->cap) {
                            vec->cap *= 2;
                            vec->data = (Value *)ul_realloc(vec->data, sizeof(Value) * vec->cap);
                        }
                        vec->data[vec->len++] = bind->val;
                    } else {
                        /* Create new vector */
                        Value vec = make_vector(0, VAL_NIL);
                        ULVector *v = AS_VECTOR(vec);
                        v->cap = n_ell > 0 ? (size_t)n_ell : 4;
                        v->data = (Value *)ul_realloc(v->data, sizeof(Value) * v->cap);
                        v->data[0] = bind->val;
                        v->len = 1;
                        env_define(bindings, bind->sym, vec);
                    }
                    bind = bind->next;
                }
            }
        }

        /* Match rest */
        Value rest_form = list_to_value(items + n_ell, nitems - n_ell);
        ul_free(items);
        return sr_match(st, rest_pat, rest_form, bindings);
    }

    /* Normal pair */
    if (!IS_PAIR(form)) return false;
    return sr_match(st, CAR(pat), CAR(form), bindings) &&
           sr_match(st, CDR(pat), CDR(form), bindings);
}

static Value sr_expand(SyntaxTransformer *st, Value tmpl, Env *bindings) {
    if (IS_NIL(tmpl) || tmpl == VAL_TRUE || tmpl == VAL_FALSE) return tmpl;
    if (IS_INT(tmpl) || IS_DOUBLE(tmpl)) return tmpl;
    if (IS_STRING(tmpl)) return tmpl;

    if (IS_SYM(tmpl)) {
        TRY(ctx) {
            Value v = env_lookup(bindings, tmpl);
            if (IS_VECTOR(v)) {
                lisp_error("syntax-rules: %s used without ...", sym_name(tmpl));
            }
            return v;
        } CATCH {
            return tmpl; /* Not bound — return as-is */
        } ENDTRY;
        return tmpl;
    }

    if (!IS_PAIR(tmpl)) return tmpl;

    /* Check for ellipsis in template: (sub_tmpl ...) */
    if (IS_PAIR(CDR(tmpl)) && CADR(tmpl) == SYM_ELLIPSIS) {
        Value sub_tmpl = CAR(tmpl);
        Value rest_tmpl = CDDR(tmpl);

        /* Find ellipsis variables in sub_tmpl */
        /* Look for symbols that have vector bindings */
        int n = -1;
        /* We need to find the length of ellipsis vectors */
        /* Scan bindings for vectors */
        for (size_t b = 0; b < bindings->nbuckets; b++) {
            EnvBinding *bind = bindings->buckets[b];
            while (bind) {
                if (IS_VECTOR(bind->val)) {
                    int vlen = (int)AS_VECTOR(bind->val)->len;
                    if (n < 0) n = vlen;
                    /* Use minimum? Actually all should be same length */
                }
                bind = bind->next;
            }
        }
        if (n < 0) n = 0;

        /* Expand each iteration */
        Value *expanded = (Value *)ul_malloc(sizeof(Value) * n);
        for (int i = 0; i < n; i++) {
            /* Create a sub-binding env where vector vars are replaced by their i-th element */
            Env *sb = make_env(NULL);
            for (size_t b = 0; b < bindings->nbuckets; b++) {
                EnvBinding *bind = bindings->buckets[b];
                while (bind) {
                    if (IS_VECTOR(bind->val)) {
                        ULVector *vec = AS_VECTOR(bind->val);
                        env_define(sb, bind->sym, i < (int)vec->len ? vec->data[i] : VAL_VOID);
                    } else {
                        env_define(sb, bind->sym, bind->val);
                    }
                    bind = bind->next;
                }
            }
            expanded[i] = sr_expand(st, sub_tmpl, sb);
        }

        Value rest = sr_expand(st, rest_tmpl, bindings);
        for (int i = n - 1; i >= 0; i--) {
            rest = cons(expanded[i], rest);
        }
        ul_free(expanded);
        return rest;
    }

    return cons(sr_expand(st, CAR(tmpl), bindings),
                sr_expand(st, CDR(tmpl), bindings));
}

Value syntax_transform_value(SyntaxTransformer *st, Value form) {
    for (int i = 0; i < st->nrules; i++) {
        Env *bindings = make_env(NULL);
        Value pat = st->rules[i].pattern;
        /* pat.cdr is the actual pattern (skip keyword) */
        Value actual_pat = IS_PAIR(pat) ? CDR(pat) : VAL_NIL;
        if (sr_match(st, actual_pat, form, bindings)) {
            return sr_expand(st, st->rules[i].tmpl, bindings);
        }
    }
    lisp_error("syntax error: no matching syntax-rules pattern");
    return VAL_NIL;
}

/* ═══════════════════════════════════════════════════════════════════════════
 * Main evaluator — TCO via explicit while loop
 * ═══════════════════════════════════════════════════════════════════════════ */

Value leval(Value expr, Env *env) {
    while (1) {
        /* Self-evaluating */
        if (IS_NIL(expr) || IS_VOID(expr) || IS_TRUE(expr) || IS_FALSE(expr) ||
            IS_EOF(expr) || IS_CHAR(expr)) return expr;
        if (IS_INT(expr) || IS_DOUBLE(expr) || IS_RATIONAL(expr)) return expr;
        if (IS_STRING(expr)) return expr;
        if (IS_VECTOR(expr)) return expr;
        if (IS_BUILTIN(expr)) return expr;

        /* Symbol lookup */
        if (IS_SYM(expr)) return env_lookup(env, expr);

        if (!IS_PAIR(expr)) return expr;

        Value head = CAR(expr);
        Value tail = CDR(expr);

        /* ── Special forms ──────────────────────────────────────────────── */

        if (head == SYM_QUOTE) {
            return CAR(tail);
        }

        if (head == SYM_IF) {
            Value *a; int na = value_to_list(tail, &a);
            if (na < 2 || na > 3) lisp_error("if: need 2-3 subforms");
            if (IS_TRUTHY(leval(a[0], env))) {
                expr = a[1];
            } else {
                expr = na == 3 ? a[2] : VAL_VOID;
            }
            ul_free(a);
            continue;
        }

        if (head == SYM_COND) {
            Value *clauses; int nc = value_to_list(tail, &clauses);
            Value result = VAL_VOID;
            bool found = false;
            for (int i = 0; i < nc; i++) {
                Value *cl; int ncl = value_to_list(clauses[i], &cl);
                if (ncl == 0) { ul_free(cl); lisp_error("cond: empty clause"); }
                if (cl[0] == SYM_ELSE || IS_TRUTHY(leval(cl[0], env))) {
                    if (ncl == 1) {
                        result = cl[0] != SYM_ELSE ? leval(cl[0], env) : VAL_VOID;
                        ul_free(cl);
                        found = true;
                        break;
                    }
                    if (ncl == 3 && cl[1] == SYM_ARROW) {
                        Value v = leval(cl[0], env);
                        Value f = leval(cl[2], env);
                        ul_free(cl);
                        ul_free(clauses);
                        Value args[1] = {v};
                        if (IS_PROC(f)) {
                            Proc *p = AS_PROC(f);
                            env = env_child(p->env, p->params, p->nparams, p->rest, args, 1);
                            Value *body_exprs = p->body.exprs;
                            int nbody = p->body.count;
                            for (int j = 0; j < nbody - 1; j++) leval(body_exprs[j], env);
                            expr = body_exprs[nbody - 1];
                            goto next_iter;
                        }
                        return call_proc(f, args, 1, env);
                    }
                    for (int j = 1; j < ncl - 1; j++) leval(cl[j], env);
                    expr = cl[ncl - 1];
                    ul_free(cl);
                    ul_free(clauses);
                    goto next_iter;
                }
                ul_free(cl);
            }
            ul_free(clauses);
            if (!found) return result;
            return result;
        }

        if (head == SYM_CASE) {
            /* (case key ((datum ...) body ...) ... (else body ...)) */
            Value *a; int na = value_to_list(tail, &a);
            Value key = leval(a[0], env);
            for (int i = 1; i < na; i++) {
                Value *cl; int ncl = value_to_list(a[i], &cl);
                if (ncl < 1) { ul_free(cl); continue; }
                if (cl[0] == SYM_ELSE) {
                    for (int j = 1; j < ncl - 1; j++) leval(cl[j], env);
                    expr = cl[ncl - 1];
                    ul_free(cl); ul_free(a);
                    goto next_iter;
                }
                /* Check if key is in datum list */
                Value *datums; int nd = value_to_list(cl[0], &datums);
                bool match = false;
                for (int j = 0; j < nd; j++) {
                    if (values_equal(key, datums[j])) { match = true; break; }
                }
                ul_free(datums);
                if (match) {
                    for (int j = 1; j < ncl - 1; j++) leval(cl[j], env);
                    expr = cl[ncl - 1];
                    ul_free(cl); ul_free(a);
                    goto next_iter;
                }
                ul_free(cl);
            }
            ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_AND) {
            Value *a; int na = value_to_list(tail, &a);
            if (na == 0) { ul_free(a); return VAL_TRUE; }
            for (int i = 0; i < na - 1; i++) {
                Value v = leval(a[i], env);
                if (!IS_TRUTHY(v)) { ul_free(a); return VAL_FALSE; }
            }
            expr = a[na - 1];
            ul_free(a);
            continue;
        }

        if (head == SYM_OR) {
            Value *a; int na = value_to_list(tail, &a);
            if (na == 0) { ul_free(a); return VAL_FALSE; }
            for (int i = 0; i < na - 1; i++) {
                Value v = leval(a[i], env);
                if (IS_TRUTHY(v)) { ul_free(a); return v; }
            }
            expr = a[na - 1];
            ul_free(a);
            continue;
        }

        if (head == SYM_WHEN) {
            Value *a; int na = value_to_list(tail, &a);
            if (IS_TRUTHY(leval(a[0], env))) {
                for (int i = 1; i < na - 1; i++) leval(a[i], env);
                expr = a[na - 1];
                ul_free(a);
                continue;
            }
            ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_UNLESS) {
            Value *a; int na = value_to_list(tail, &a);
            if (!IS_TRUTHY(leval(a[0], env))) {
                for (int i = 1; i < na - 1; i++) leval(a[i], env);
                expr = a[na - 1];
                ul_free(a);
                continue;
            }
            ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_BEGIN) {
            Value *a; int na = value_to_list(tail, &a);
            if (na == 0) { ul_free(a); return VAL_VOID; }
            for (int i = 0; i < na - 1; i++) leval(a[i], env);
            expr = a[na - 1];
            ul_free(a);
            continue;
        }

        if (head == SYM_DEFINE) {
            Value *a; int na = value_to_list(tail, &a);
            if (na == 0) lisp_error("define: empty");
            if (IS_PAIR(a[0])) {
                /* (define (f x) body...) */
                Value fname = CAR(a[0]);
                Formals f = parse_formals(CDR(a[0]));
                ExprList body = {a + 1, na - 1};
                Proc *p = make_proc(f.params, f.nparams, f.rest, body, env, sym_name(fname));
                Value pval = VAL_PTR(p);
                if (g_auto_compile) {
                    TRY(ctx) {
                        CompiledProc *cp = compile_proc(p, env);
                        pval = VAL_PTR(cp);
                    } CATCH { } ENDTRY;
                }
                env_define(env, fname, pval);
            } else {
                Value name = a[0];
                if (!IS_SYM(name)) lisp_error("define: name must be symbol");
                Value val = na > 1 ? leval(a[1], env) : VAL_VOID;
                if (IS_PROC(val) && !AS_PROC(val)->name) {
                    AS_PROC(val)->name = ul_strdup(sym_name(name));
                }
                if (g_auto_compile && IS_PROC(val)) {
                    TRY(ctx) {
                        CompiledProc *cp = compile_proc(AS_PROC(val), env);
                        val = VAL_PTR(cp);
                    } CATCH { } ENDTRY;
                }
                env_define(env, name, val);
            }
            ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_DEFINE_VALUES) {
            Value *a; int na = value_to_list(tail, &a);
            Value *names; int nn = value_to_list(a[0], &names);
            Value vals = leval(a[1], env);
            /* vals could be a vector of multiple values (we use vectors for multi-values) */
            if (IS_VECTOR(vals)) {
                ULVector *vv = AS_VECTOR(vals);
                for (int i = 0; i < nn && i < (int)vv->len; i++) {
                    env_define(env, names[i], vv->data[i]);
                }
            } else {
                if (nn > 0) env_define(env, names[0], vals);
            }
            ul_free(names); ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_SET) {
            Value *a; int na = value_to_list(tail, &a);
            (void)na;
            env_set(env, a[0], leval(a[1], env));
            ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_LAMBDA || head == SYM_LAMBDA_UC) {
            Value *a; int na = value_to_list(tail, &a);
            if (na == 0) lisp_error("lambda: empty");
            Formals f = parse_formals(a[0]);
            ExprList body = {a + 1, na - 1};
            Proc *p = make_proc(f.params, f.nparams, f.rest, body, env, NULL);
            Value pval = VAL_PTR(p);
            if (g_auto_compile) {
                TRY(ctx) {
                    CompiledProc *cp = compile_proc(p, env);
                    pval = VAL_PTR(cp);
                } CATCH { } ENDTRY;
            }
            ul_free(a);
            return pval;
        }

        if (head == SYM_LET) {
            Value *a; int na = value_to_list(tail, &a);
            if (na == 0) lisp_error("let: empty");
            if (IS_SYM(a[0])) {
                /* Named let: (let name ((v init) ...) body...) */
                Value name = a[0];
                Value *binds; int nb = value_to_list(a[1], &binds);
                int nbody = na - 2;
                Value *body_arr = a + 2;

                Value *bps = (Value *)ul_malloc(sizeof(Value) * nb);
                Value *bvs = (Value *)ul_malloc(sizeof(Value) * nb);
                for (int i = 0; i < nb; i++) {
                    Value *bp; int nbp = value_to_list(binds[i], &bp);
                    bps[i] = bp[0];
                    bvs[i] = leval(bp[1], env);
                    ul_free(bp);
                }
                Env *c = make_env(env);
                ExprList body = {body_arr, nbody};
                Proc *p = make_proc(bps, nb, VAL_NIL, body, c, sym_name(name));
                env_define(c, name, VAL_PTR(p));
                env = env_child(c, bps, nb, VAL_NIL, bvs, nb);
                if (has_internal_defines(body)) {
                    ExprList b2 = body_with_env(body_arr, nbody, env);
                    for (int i = 0; i < b2.count - 1; i++) leval(b2.exprs[i], env);
                    expr = b2.exprs[b2.count - 1];
                } else {
                    for (int i = 0; i < nbody - 1; i++) leval(body_arr[i], env);
                    expr = body_arr[nbody - 1];
                }
                ul_free(bps); ul_free(bvs); ul_free(binds); ul_free(a);
                continue;
            }
            /* Regular let */
            Value *binds; int nb = value_to_list(a[0], &binds);
            int nbody = na - 1;
            Value *body_arr = a + 1;
            Env *c = make_env(env);
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                env_define(c, bp[0], leval(bp[1], env));
                ul_free(bp);
            }
            env = c;
            ExprList body = {body_arr, nbody};
            if (has_internal_defines(body)) {
                ExprList b2 = body_with_env(body_arr, nbody, env);
                for (int i = 0; i < b2.count - 1; i++) leval(b2.exprs[i], env);
                expr = b2.exprs[b2.count - 1];
            } else {
                for (int i = 0; i < nbody - 1; i++) leval(body_arr[i], env);
                expr = body_arr[nbody - 1];
            }
            ul_free(binds); ul_free(a);
            continue;
        }

        if (head == SYM_LET_STAR) {
            Value *a; int na = value_to_list(tail, &a);
            Value *binds; int nb = value_to_list(a[0], &binds);
            Env *c = make_env(env);
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                env_define(c, bp[0], leval(bp[1], c));
                ul_free(bp);
            }
            int nbody = na - 1;
            Value *body_arr = a + 1;
            ExprList body = {body_arr, nbody};
            env = c;
            if (has_internal_defines(body)) {
                ExprList b2 = body_with_env(body_arr, nbody, env);
                for (int i = 0; i < b2.count - 1; i++) leval(b2.exprs[i], env);
                expr = b2.exprs[b2.count - 1];
            } else {
                for (int i = 0; i < nbody - 1; i++) leval(body_arr[i], env);
                expr = body_arr[nbody - 1];
            }
            ul_free(binds); ul_free(a);
            continue;
        }

        if (head == SYM_LETREC || head == SYM_LETREC_STAR) {
            Value *a; int na = value_to_list(tail, &a);
            Value *binds; int nb = value_to_list(a[0], &binds);
            Env *c = make_env(env);
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                env_define(c, bp[0], VAL_VOID);
                ul_free(bp);
            }
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                env_set(c, bp[0], leval(bp[1], c));
                ul_free(bp);
            }
            int nbody = na - 1;
            Value *body_arr = a + 1;
            env = c;
            ExprList body = {body_arr, nbody};
            if (has_internal_defines(body)) {
                ExprList b2 = body_with_env(body_arr, nbody, env);
                for (int i = 0; i < b2.count - 1; i++) leval(b2.exprs[i], env);
                expr = b2.exprs[b2.count - 1];
            } else {
                for (int i = 0; i < nbody - 1; i++) leval(body_arr[i], env);
                expr = body_arr[nbody - 1];
            }
            ul_free(binds); ul_free(a);
            continue;
        }

        if (head == SYM_DO) {
            Value *a; int na = value_to_list(tail, &a);
            Value *vcs; int nvc = value_to_list(a[0], &vcs);
            Value *term; int nterm = value_to_list(a[1], &term);
            int nbody = na - 2;
            Value *body_arr = a + 2;

            Env *c = make_env(env);
            /* Parse variable specs: (var init step) */
            typedef struct { Value var; Value step; } DoSpec;
            DoSpec *specs = (DoSpec *)ul_malloc(sizeof(DoSpec) * nvc);
            for (int i = 0; i < nvc; i++) {
                Value *sp; int nsp = value_to_list(vcs[i], &sp);
                specs[i].var = sp[0];
                env_define(c, sp[0], leval(sp[1], env));
                specs[i].step = nsp > 2 ? sp[2] : sp[0];
                ul_free(sp);
            }

            while (1) {
                if (IS_TRUTHY(leval(term[0], c))) {
                    if (nterm == 1) {
                        expr = VAL_VOID;
                    } else {
                        for (int i = 1; i < nterm - 1; i++) leval(term[i], c);
                        expr = term[nterm - 1];
                    }
                    env = c;
                    break;
                }
                for (int i = 0; i < nbody; i++) leval(body_arr[i], c);
                Value *nvs = (Value *)ul_malloc(sizeof(Value) * nvc);
                for (int i = 0; i < nvc; i++) nvs[i] = leval(specs[i].step, c);
                for (int i = 0; i < nvc; i++) env_set(c, specs[i].var, nvs[i]);
                ul_free(nvs);
            }
            ul_free(specs); ul_free(vcs); ul_free(term); ul_free(a);
            continue;
        }

        if (head == SYM_QUASIQUOTE) {
            return qq_expand(CAR(tail), env, 0);
        }

        if (head == SYM_DEFINE_MACRO || head == SYM_DEFMACRO) {
            Value *a; int na = value_to_list(tail, &a);
            Value name;
            Proc *xfm;
            if (IS_PAIR(a[0])) {
                name = CAR(a[0]);
                Formals f = parse_formals(CDR(a[0]));
                ExprList body = {a + 1, na - 1};
                xfm = make_proc(f.params, f.nparams, f.rest, body, env, sym_name(name));
            } else {
                name = a[0];
                Formals f = parse_formals(a[1]);
                ExprList body = {a + 2, na - 2};
                xfm = make_proc(f.params, f.nparams, f.rest, body, env, sym_name(name));
            }
            env_define(env, name, make_macro(VAL_PTR(xfm)));
            ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_DEFINE_SYNTAX) {
            Value *a; int na = value_to_list(tail, &a);
            Value val = leval(a[1], env);
            if (IS_SYNTAX_TRANSFORMER(val)) {
                env_define(env, a[0], make_macro(val));
            } else {
                env_define(env, a[0], val);
            }
            ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_SYNTAX_RULES) {
            Value *a; int na = value_to_list(tail, &a);
            /* a[0] = literals, a[1..] = rules */
            Value *lits; int nlits = value_to_list(a[0], &lits);
            SyntaxTransformer *st = (SyntaxTransformer *)ul_malloc(sizeof(SyntaxTransformer));
            st->hdr.type = OBJ_SYNTAX_TRANSFORMER;
            st->nliterals = nlits;
            st->literals = (char **)ul_malloc(sizeof(char *) * nlits);
            for (int i = 0; i < nlits; i++) st->literals[i] = ul_strdup(sym_name(lits[i]));
            st->nrules = na - 1;
            st->rules = (SyntaxRule *)ul_malloc(sizeof(SyntaxRule) * st->nrules);
            for (int i = 0; i < st->nrules; i++) {
                Value *rl; int nrl = value_to_list(a[i + 1], &rl);
                st->rules[i].pattern = rl[0];
                st->rules[i].tmpl = rl[1];
                ul_free(rl);
            }
            st->def_env = env;
            ul_free(lits); ul_free(a);
            return VAL_PTR(st);
        }

        if (head == SYM_LET_SYNTAX) {
            Value *a; int na = value_to_list(tail, &a);
            Value *binds; int nb = value_to_list(a[0], &binds);
            Env *c = make_env(env);
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                env_define(c, bp[0], make_macro(leval(bp[1], env)));
                ul_free(bp);
            }
            int nbody = na - 1;
            for (int i = 0; i < nbody - 1; i++) leval(a[i + 1], c);
            expr = a[na - 1]; env = c;
            ul_free(binds); ul_free(a);
            continue;
        }

        if (head == SYM_LETREC_SYNTAX) {
            Value *a; int na = value_to_list(tail, &a);
            Value *binds; int nb = value_to_list(a[0], &binds);
            Env *c = make_env(env);
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                env_define(c, bp[0], make_macro(leval(bp[1], c)));
                ul_free(bp);
            }
            int nbody = na - 1;
            for (int i = 0; i < nbody - 1; i++) leval(a[i + 1], c);
            expr = a[na - 1]; env = c;
            ul_free(binds); ul_free(a);
            continue;
        }

        if (head == SYM_VALUES) {
            Value *a; int na = value_to_list(tail, &a);
            if (na == 1) { Value r = leval(a[0], env); ul_free(a); return r; }
            /* Multiple values: store in a vector */
            Value vec = make_vector(na, VAL_NIL);
            ULVector *v = AS_VECTOR(vec);
            for (int i = 0; i < na; i++) v->data[i] = leval(a[i], env);
            ul_free(a);
            return vec;
        }

        if (head == SYM_CALL_WITH_VALUES) {
            Value *a; int na = value_to_list(tail, &a);
            Value prod = leval(a[0], env);
            Value consumer = leval(a[1], env);
            ul_free(a);
            Value r = call_proc(prod, NULL, 0, env);
            if (IS_VECTOR(r)) {
                ULVector *v = AS_VECTOR(r);
                return call_proc(consumer, v->data, (int)v->len, env);
            }
            Value args[1] = {r};
            return call_proc(consumer, args, 1, env);
        }

        if (head == SYM_CALL_CC || head == SYM_CALL_CC2) {
            /* Simple escape continuation (not full in tree-walker) */
            Value *a; int na = value_to_list(tail, &a);
            Value proc = leval(a[0], env);
            ul_free(a);
            /* Escape-only call/cc using setjmp/longjmp */
            jmp_buf *saved_jmp = cc_active_jmp;
            jmp_buf local_jmp;
            cc_active_jmp = &local_jmp;

            if (setjmp(local_jmp) != 0) {
                /* Continuation was invoked — return the escape value */
                cc_active_jmp = saved_jmp;
                return cc_escape_val;
            }

            /* Build the continuation as a builtin function */
            Value kont = VAL_BUILTIN(ul_callcc_kont);
            Value kont_args[1] = {kont};
            Value result = call_proc(proc, kont_args, 1, env);
            cc_active_jmp = saved_jmp;
            return result;
        }

        if (head == SYM_APPLY) {
            Value *a; int na = value_to_list(tail, &a);
            Value proc = leval(a[0], env);
            /* Evaluate prefix args */
            int npre = na - 2;
            Value *pre = NULL;
            if (npre > 0) {
                pre = (Value *)ul_malloc(sizeof(Value) * npre);
                for (int i = 0; i < npre; i++) pre[i] = leval(a[i + 1], env);
            }
            Value last = leval(a[na - 1], env);
            Value *lst; int nlst = value_to_list(last, &lst);

            Value *all_args = (Value *)ul_malloc(sizeof(Value) * (npre + nlst));
            if (pre) memcpy(all_args, pre, sizeof(Value) * npre);
            memcpy(all_args + npre, lst, sizeof(Value) * nlst);
            int total = npre + nlst;

            ul_free(pre); ul_free(lst); ul_free(a);

            /* TCO for Proc */
            if (IS_PROC(proc)) {
                Proc *p = AS_PROC(proc);
                env = env_child(p->env, p->params, p->nparams, p->rest, all_args, total);
                ExprList body = p->has_defs ?
                    body_with_env(p->body.exprs, p->body.count, env) : p->body;
                if (body.count == 1) expr = body.exprs[0];
                else {
                    for (int i = 0; i < body.count - 1; i++) leval(body.exprs[i], env);
                    expr = body.exprs[body.count - 1];
                }
                ul_free(all_args);
                continue;
            }
            Value result = call_proc(proc, all_args, total, env);
            ul_free(all_args);
            return result;
        }

        if (head == SYM_EVAL) {
            /* Argument evaluates in the current env; result evaluates
             * in the global env so a (define ...) inside an (eval ...)
             * installs the binding where callers can see it. Matches
             * Python's leval and asm's bi_eval. */
            Value *a; int na = value_to_list(tail, &a);
            expr = leval(a[0], env);
            ul_free(a);
            env = env->global ? env->global : env;
            continue;
        }

        if (head == SYM_ERROR) {
            Value *a; int na = value_to_list(tail, &a);
            char *msg = show(leval(a[0], env), true);
            Value *irr = NULL;
            int nirr = na - 1;
            if (nirr > 0) {
                irr = (Value *)ul_malloc(sizeof(Value) * nirr);
                for (int i = 0; i < nirr; i++) irr[i] = leval(a[i + 1], env);
            }
            Value obj = make_error_object(msg, irr, nirr);
            ul_free(msg); ul_free(irr); ul_free(a);
            /* Format full message */
            char full_msg[MAX_ERROR_MSG];
            ErrorObject *eo = AS_ERROR(obj);
            int off = snprintf(full_msg, sizeof(full_msg), "%s", eo->message);
            for (int i = 0; i < eo->nirritants && off < MAX_ERROR_MSG - 2; i++) {
                char *s = show(eo->irritants[i], false);
                off += snprintf(full_msg + off, sizeof(full_msg) - off, ": %s", s);
                ul_free(s);
            }
            lisp_error_with_obj(obj, "%s", full_msg);
        }

        if (head == SYM_DEFINE_RECORD_TYPE) {
            Value *a; int na = value_to_list(tail, &a);
            Value result = define_record_type(a, na, env);
            ul_free(a);
            return result;
        }

        if (head == SYM_MODULE) {
            Value *a; int na = value_to_list(tail, &a);
            const char *mod_name = sym_name(a[0]);
            /* Check for (export sym ...) */
            char **exports = NULL;
            int nexports = 0;
            int body_start = 1;
            if (na > 1 && IS_PAIR(a[1]) && CAR(a[1]) == SYM_EXPORT) {
                Value *exp_list; int nexp = value_to_list(a[1], &exp_list);
                nexports = nexp - 1;
                exports = (char **)ul_malloc(sizeof(char *) * nexports);
                for (int i = 0; i < nexports; i++) {
                    exports[i] = ul_strdup(sym_name(exp_list[i + 1]));
                }
                ul_free(exp_list);
                body_start = 2;
            }
            Env *mod_env = make_env(env);
            for (int i = body_start; i < na; i++) leval(a[i], mod_env);

            /* Register module */
            Module *m = (Module *)ul_malloc(sizeof(Module));
            m->name = ul_strdup(mod_name);
            m->env = mod_env;
            m->exports = exports;
            m->nexports = nexports;
            m->next = g_modules;
            g_modules = m;

            ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_IMPORT) {
            Value *specs; int nspecs = value_to_list(tail, &specs);
            for (int i = 0; i < nspecs; i++) {
                const char *mod_name;
                char **syms = NULL;
                int nsyms = 0;

                if (IS_SYM(specs[i])) {
                    mod_name = sym_name(specs[i]);
                } else if (IS_PAIR(specs[i])) {
                    Value *items; int ni = value_to_list(specs[i], &items);
                    mod_name = sym_name(items[0]);
                    if (ni > 1) {
                        nsyms = ni - 1;
                        syms = (char **)ul_malloc(sizeof(char *) * nsyms);
                        for (int j = 0; j < nsyms; j++) syms[j] = ul_strdup(sym_name(items[j + 1]));
                    }
                    ul_free(items);
                } else {
                    continue;
                }

                /* Find module */
                Module *m = g_modules;
                while (m && strcmp(m->name, mod_name) != 0) m = m->next;
                if (!m) lisp_error("import: unknown module: %s", mod_name);

                if (syms) {
                    for (int j = 0; j < nsyms; j++) {
                        Value sym = intern(syms[j]);
                        TRY(ctx) {
                            Value val = env_lookup(m->env, sym);
                            env_define(env, sym, val);
                        } CATCH {
                            lisp_error("import: %s has no export: %s", mod_name, syms[j]);
                        } ENDTRY;
                        ul_free(syms[j]);
                    }
                    ul_free(syms);
                } else {
                    /* Import all exports or all bindings */
                    if (m->nexports > 0) {
                        for (int j = 0; j < m->nexports; j++) {
                            Value sym = intern(m->exports[j]);
                            TRY(ctx) {
                                Value val = env_lookup(m->env, sym);
                                env_define(env, sym, val);
                            } CATCH { } ENDTRY;
                        }
                    } else {
                        /* Export everything from mod_env local bindings */
                        for (size_t b = 0; b < m->env->nbuckets; b++) {
                            EnvBinding *bind = m->env->buckets[b];
                            while (bind) {
                                env_define(env, bind->sym, bind->val);
                                bind = bind->next;
                            }
                        }
                    }
                }
            }
            ul_free(specs);
            return VAL_VOID;
        }

        if (head == SYM_LOAD) {
            Value *a; int na = value_to_list(tail, &a);
            char *path = show(leval(a[0], env), true);
            load_file(path, env);
            ul_free(path); ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_INCLUDE) {
            Value *a; int na = value_to_list(tail, &a);
            for (int i = 0; i < na; i++) {
                char *path = show(leval(a[i], env), true);
                load_file(path, env);
                ul_free(path);
            }
            ul_free(a);
            return VAL_VOID;
        }

        if (head == SYM_PARAMETERIZE) {
            Value *a; int na = value_to_list(tail, &a);
            Value *binds; int nb = value_to_list(a[0], &binds);
            int nbody = na - 1;
            Value *body_arr = a + 1;

            /* Save old values and set new */
            typedef struct { Value param; Value old_val; } PBind;
            PBind *pb = (PBind *)ul_malloc(sizeof(PBind) * nb);
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                pb[i].param = leval(bp[0], env);
                Value new_val = leval(bp[1], env);
                pb[i].old_val = call_proc(pb[i].param, NULL, 0, env);
                Value sv[1] = {new_val};
                call_proc(pb[i].param, sv, 1, env);
                ul_free(bp);
            }

            Value result = VAL_VOID;
            TRY(ctx) {
                for (int i = 0; i < nbody - 1; i++) leval(body_arr[i], env);
                result = leval(body_arr[nbody - 1], env);
            } CATCH {
                /* Restore on error */
                for (int i = 0; i < nb; i++) {
                    Value sv[1] = {pb[i].old_val};
                    call_proc(pb[i].param, sv, 1, env);
                }
                ul_free(pb); ul_free(binds); ul_free(a);
                lisp_error("%s", ctx.message);
            } ENDTRY;

            /* Restore */
            for (int i = 0; i < nb; i++) {
                Value sv[1] = {pb[i].old_val};
                call_proc(pb[i].param, sv, 1, env);
            }
            ul_free(pb); ul_free(binds); ul_free(a);
            return result;
        }

        if (head == SYM_DYNAMIC_WIND) {
            Value *a; int na = value_to_list(tail, &a);
            Value before = leval(a[0], env);
            Value thunk = leval(a[1], env);
            Value after = leval(a[2], env);
            ul_free(a);
            call_proc(before, NULL, 0, env);
            Value result;
            TRY(ctx) {
                result = call_proc(thunk, NULL, 0, env);
            } CATCH {
                call_proc(after, NULL, 0, env);
                lisp_error("%s", ctx.message);
            } ENDTRY;
            call_proc(after, NULL, 0, env);
            return result;
        }

        if (head == SYM_WITH_EXCEPTION_HANDLER) {
            Value *a; int na = value_to_list(tail, &a);
            Value handler = leval(a[0], env);
            Value thunk = leval(a[1], env);
            ul_free(a);
            TRY(ctx) {
                return call_proc(thunk, NULL, 0, env);
            } CATCH {
                Value err_val = ctx.error_obj;
                if (IS_NIL(err_val)) err_val = make_string_from_cstr(ctx.message);
                Value args[1] = {err_val};
                return call_proc(handler, args, 1, env);
            } ENDTRY;
            return VAL_VOID;
        }

        if (head == SYM_GUARD) {
            Value *a; int na = value_to_list(tail, &a);
            Value *var_clauses; int nvc = value_to_list(a[0], &var_clauses);
            Value var = var_clauses[0];
            int nclauses = nvc - 1;
            int nbody = na - 1;

            TRY(ctx) {
                for (int i = 0; i < nbody - 1; i++) leval(a[i + 1], env);
                Value result = leval(a[nbody], env);
                ul_free(var_clauses); ul_free(a);
                return result;
            } CATCH {
                Env *c = make_env(env);
                Value err_val = ctx.error_obj;
                if (IS_NIL(err_val)) err_val = make_string_from_cstr(ctx.message);
                env_define(c, var, err_val);

                for (int i = 0; i < nclauses; i++) {
                    Value *cl; int ncl = value_to_list(var_clauses[i + 1], &cl);
                    if (cl[0] == SYM_ELSE || IS_TRUTHY(leval(cl[0], c))) {
                        for (int j = 1; j < ncl - 1; j++) leval(cl[j], c);
                        Value result = leval(cl[ncl - 1], c);
                        ul_free(cl); ul_free(var_clauses); ul_free(a);
                        return result;
                    }
                    ul_free(cl);
                }
                /* No clause matched — re-raise */
                ul_free(var_clauses); ul_free(a);
                lisp_error("%s", ctx.message);
            } ENDTRY;
            return VAL_VOID;
        }

        if (head == SYM_LET_VALUES) {
            Value *a; int na = value_to_list(tail, &a);
            Value *binds; int nb = value_to_list(a[0], &binds);
            Env *c = make_env(env);
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                Value val = leval(bp[1], env);
                Value *fmls; int nf = value_to_list(bp[0], &fmls);
                if (IS_VECTOR(val)) {
                    ULVector *vv = AS_VECTOR(val);
                    for (int j = 0; j < nf && j < (int)vv->len; j++)
                        env_define(c, fmls[j], vv->data[j]);
                } else {
                    if (nf > 0) env_define(c, fmls[0], val);
                }
                ul_free(fmls); ul_free(bp);
            }
            int nbody = na - 1;
            env = c;
            for (int i = 0; i < nbody - 1; i++) leval(a[i + 1], env);
            expr = a[na - 1];
            ul_free(binds); ul_free(a);
            continue;
        }

        /* ── Macro expansion ─────────────────────────────────────────── */
        Value hval;
        TRY(ctx) {
            hval = leval(head, env);
        } CATCH {
            lisp_error("not callable: %s", show(head, false));
        } ENDTRY;

        if (IS_MACRO(hval)) {
            ULMacro *m = AS_MACRO(hval);
            if (IS_SYNTAX_TRANSFORMER(m->transformer)) {
                Value *a; int na = value_to_list(tail, &a);
                Value form = list_to_value(a, na);
                expr = syntax_transform_value(AS_SYNTAX_TRANSFORMER(m->transformer), form);
                ul_free(a);
                continue;
            }
            /* Regular macro */
            Value *a; int na = value_to_list(tail, &a);
            expr = call_proc(m->transformer, a, na, env);
            ul_free(a);
            continue;
        }

        /* ── Procedure application ────────────────────────────────────── */
        Value proc = hval;
        Value *args; int nargs = value_to_list(tail, &args);
        for (int i = 0; i < nargs; i++) {
            args[i] = leval(args[i], env);
        }

        if (IS_PROC(proc)) {
            Proc *p = AS_PROC(proc);

            /* JIT fast path */
            if (g_jit_enabled && p->jit_block == NULL && nargs <= 6) {
                JitBlock *jb2 = jit_compile(p);
                p->jit_block = jb2 ? (void *)jb2 : (void *)(uintptr_t)1;
            }
            if (p->jit_block && p->jit_block != (void *)(uintptr_t)1) {
                JitBlock *jb = (JitBlock *)p->jit_block;
                Value pad[6] = {0};
                for (int i = 0; i < nargs && i < 6; i++) pad[i] = args[i];
                ul_free(args);
                return jb->func(pad[0], pad[1], pad[2], pad[3], pad[4], pad[5]);
            }

            env = env_child(p->env, p->params, p->nparams, p->rest, args, nargs);
            ExprList body = p->has_defs ?
                body_with_env(p->body.exprs, p->body.count, env) : p->body;
            if (body.count == 1) expr = body.exprs[0];
            else {
                for (int i = 0; i < body.count - 1; i++) leval(body.exprs[i], env);
                expr = body.exprs[body.count - 1];
            }
            ul_free(args);
            continue;
        }

        if (IS_COMPILED_PROC(proc)) {
            CompiledProc *cp = AS_COMPILED_PROC(proc);
            Env *c = env_child(cp->env, cp->params, cp->nparams, cp->rest, args, nargs);
            ul_free(args);
            return vm_exec(cp->code, c);
        }

        if (IS_BUILTIN(proc)) {
            Value result = AS_BUILTIN(proc)(args, nargs, env);
            ul_free(args);
            return result;
        }

        if (IS_CONTINUATION(proc)) {
            Value val = (nargs > 0) ? args[0] : VAL_VOID;
            ul_free(args);
            if (!g_cont_trampoline || !g_cont_trampoline->active) {
                lisp_error("continuation invoked outside VM execution");
            }
            g_cont_invoked = AS_CONTINUATION(proc);
            g_cont_invoked_val = val;
            longjmp(g_cont_trampoline->jmp, 1);
        }

        char *s = show(proc, false);
        lisp_error("not callable: %s", s);

next_iter:
        continue;
    }
}

/* ═══════════════════════════════════════════════════════════════════════════
 * File loading
 * ═══════════════════════════════════════════════════════════════════════════ */

void load_file(const char *path, Env *env) {
    FILE *f = fopen(path, "r");
    if (!f) lisp_error("file not found: %s", path);

    /* Seekable files (regular): size up-front, single read.
     * Non-seekable files (pipes, FIFOs, sockets — e.g. bash process
     * substitution <(...) yields /proc/self/fd/N pointing at a pipe):
     * ftell returns -1, which silently casts to SIZE_MAX inside fread
     * and overruns the heap. Stream-read into a growable buffer instead. */
    char *src = NULL;
    long sz = -1;
    if (fseek(f, 0, SEEK_END) == 0) {
        sz = ftell(f);
        if (fseek(f, 0, SEEK_SET) != 0) sz = -1;
    }
    if (sz >= 0) {
        src = (char *)ul_malloc((size_t)sz + 1);
        size_t nread = fread(src, 1, (size_t)sz, f);
        src[nread] = '\0';
    } else {
        size_t cap = 4096;
        size_t len = 0;
        src = (char *)ul_malloc(cap);
        for (;;) {
            if (len + 1 >= cap) {
                cap *= 2;
                src = (char *)ul_realloc(src, cap);
            }
            size_t got = fread(src + len, 1, cap - 1 - len, f);
            len += got;
            if (got == 0) break;
        }
        src[len] = '\0';
    }
    fclose(f);

    int count;
    Value *exprs = read_all(src, &count, true);
    ul_free(src);

    for (int i = 0; i < count; i++) {
        leval(exprs[i], env);
    }
    ul_free(exprs);
}
