/*
 * vm.c — Bytecode compiler + stack-based VM
 */
#include "lumbda.h"

/* ═══════════════════════════════════════════════════════════════════════════
 * CodeObj
 * ═══════════════════════════════════════════════════════════════════════════ */

CodeObj *make_code(const char *name) {
    CodeObj *c = (CodeObj *)ul_malloc(sizeof(CodeObj));
    c->hdr.type = OBJ_CODE;
    c->cap = 64;
    c->count = 0;
    /* Instruction carries a Value `arg` — buffer needs precise tracing. */
    c->instrs = (Instruction *)ul_malloc_values(sizeof(Instruction) * c->cap);
    c->source_map = (int *)ul_malloc(sizeof(int) * c->cap);
    c->name = name ? ul_strdup(name) : NULL;
    c->self_name = NULL;
    c->self_params = NULL;
    c->self_nparams = 0;
    return c;
}

int code_emit(CodeObj *c, Opcode op, Value arg) {
    if (c->count >= c->cap) {
        c->cap *= 2;
        c->instrs = (Instruction *)ul_realloc_values(c->instrs, sizeof(Instruction) * c->cap);
        c->source_map = (int *)ul_realloc(c->source_map, sizeof(int) * c->cap);
    }
    /* 2026-06-14 self-tail-call frame-unwind: track env-frame depth so
       OP_SELF_TAIL_CALL pops accumulated let/let-star/letrec/do frames. */
    if (op == OP_PUSH_ENV) c->scope_depth++;
    else if (op == OP_POP_ENV) c->scope_depth--;
    int idx = c->count;
    c->instrs[idx].op = op;
    c->instrs[idx].arg = arg;
    c->instrs[idx].arg2 = 0;
    c->source_map[idx] = 0;
    c->count++;
    return idx;
}

void code_emit2(CodeObj *c, Opcode op, Value arg, int arg2) {
    int idx = code_emit(c, op, arg);
    c->instrs[idx].arg2 = arg2;
}

void code_patch(CodeObj *c, int addr, Value arg) {
    c->instrs[addr].arg = arg;
}

/* ═══════════════════════════════════════════════════════════════════════════
 * Bytecode compiler
 * ═══════════════════════════════════════════════════════════════════════════ */

static bool bc_is_global(Value sym, Env *env) {
    Env *e = env;
    Env *g = e->global;
    while (e && e != g) {
        /* Check if sym is locally bound */
        EnvBinding *b = NULL;
        uint32_t h = (uint32_t)((GET_PAYLOAD(sym) * 2654435761ULL) % e->nbuckets);
        b = e->buckets[h];
        while (b) { if (b->sym == sym) return false; b = b->next; }
        e = e->parent;
    }
    return true;
}

/* Fallback forms — these get compiled to OP_EVAL */
static bool is_fallback_form(Value head) {
    return head == SYM_QUASIQUOTE || head == SYM_DEFINE_MACRO || head == SYM_DEFMACRO ||
           head == SYM_DEFINE_SYNTAX || head == SYM_LET_SYNTAX || head == SYM_LETREC_SYNTAX ||
           head == SYM_SYNTAX_RULES || head == SYM_DEFINE_VALUES || head == SYM_LET_VALUES ||
           head == SYM_LET_STAR_VALUES || head == SYM_DEFINE_RECORD_TYPE ||
           head == SYM_MODULE || head == SYM_IMPORT || head == SYM_INCLUDE || head == SYM_LOAD ||
           head == SYM_PARAMETERIZE || head == SYM_DYNAMIC_WIND ||
           head == SYM_WITH_EXCEPTION_HANDLER || head == SYM_GUARD ||
           head == SYM_CALL_WITH_VALUES || head == SYM_VALUES || head == SYM_EVAL ||
           head == SYM_ERROR || head == SYM_CASE;
}

static void bc_body(Value *body, int nbody, CodeObj *code, Env *env, bool tail) {
    if (nbody == 0) { code_emit(code, OP_VOID, VAL_NIL); return; }
    for (int i = 0; i < nbody - 1; i++) {
        bc_compile(body[i], code, env, false);
        code_emit(code, OP_POP, VAL_NIL);
    }
    bc_compile(body[nbody - 1], code, env, tail);
}

CodeObj *bc_lambda(Value *body, int nbody, Value *params, int nparams,
                   Value rest, Env *env, const char *name,
                   const char *self_name, Value *self_params, int self_nparams) {
    CodeObj *inner = make_code(name);
    if (self_name) {
        inner->self_name = ul_strdup(self_name);
        inner->self_params = (Value *)ul_malloc_values(sizeof(Value) * self_nparams);
        memcpy(inner->self_params, self_params, sizeof(Value) * self_nparams);
        inner->self_nparams = self_nparams;
    }

    /* Handle internal defines */
    int i = 0;
    Value *def_names = NULL;
    int ndef = 0;
    Value *expanded = (Value *)ul_malloc_values(sizeof(Value) * (nbody + 64));
    memcpy(expanded, body, sizeof(Value) * nbody);
    int n = nbody;

    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 nm = IS_PAIR(a[0]) ? CAR(a[0]) : a[0];
            if (IS_SYM(nm)) {
                def_names = (Value *)ul_realloc_values(def_names, sizeof(Value) * (ndef + 1));
                def_names[ndef++] = nm;
            }
            ul_free(a);
            i++;
        } else if (IS_PAIR(f) && CAR(f) == SYM_BEGIN) {
            Value *spliced; int ns = value_to_list(CDR(f), &spliced);
            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);
        } else {
            break;
        }
    }

    if (ndef > 0) {
        code_emit(inner, OP_PUSH_ENV, VAL_NIL);
        for (int j = 0; j < ndef; j++) {
            code_emit(inner, OP_VOID, VAL_NIL);
            code_emit(inner, OP_BIND, def_names[j]);
        }
    }
    /* 2026-06-14: record baseline depth after internal-defines frame.
       Self-tail-call unwinds back to here, not all the way to 0. */
    inner->self_base = inner->scope_depth;

    bc_body(expanded, n, inner, env, true);
    code_emit(inner, OP_RETURN, VAL_NIL);

    ul_free(expanded);
    ul_free(def_names);
    return inner;
}

void bc_compile(Value expr, CodeObj *code, Env *env, bool tail) {
    /* Self-evaluating */
    if (IS_VOID(expr)) { code_emit(code, OP_VOID, VAL_NIL); return; }
    if (IS_NIL(expr) || IS_TRUE(expr) || IS_FALSE(expr) || IS_EOF(expr) || IS_CHAR(expr)) {
        code_emit(code, OP_CONST, expr); return;
    }
    if (IS_INT(expr) || IS_DOUBLE(expr) || IS_RATIONAL(expr) || IS_BIGNUM(expr)) {
        code_emit(code, OP_CONST, expr); return;
    }
    if (IS_STRING(expr) || IS_VECTOR(expr)) {
        code_emit(code, OP_CONST, expr); return;
    }
    if (IS_SYM(expr)) { code_emit(code, OP_LOOKUP, expr); return; }
    if (!IS_PAIR(expr)) { code_emit(code, OP_CONST, expr); return; }

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

    /* Fallback forms */
    if (IS_SYM(head) && is_fallback_form(head)) {
        code_emit(code, OP_EVAL, expr); return;
    }

    /* quote */
    if (head == SYM_QUOTE) { code_emit(code, OP_CONST, CADR(expr)); return; }

    /* if */
    if (head == SYM_IF) {
        Value *a; int na = value_to_list(args, &a);
        bc_compile(a[0], code, env, false);
        int jf = code_emit(code, OP_JUMP_IF_FALSE, VAL_NIL);
        bc_compile(a[1], code, env, tail);
        int je = code_emit(code, OP_JUMP, VAL_NIL);
        code_patch(code, jf, VAL_INT(code->count));
        if (na > 2) bc_compile(a[2], code, env, tail);
        else code_emit(code, OP_VOID, VAL_NIL);
        code_patch(code, je, VAL_INT(code->count));
        ul_free(a); return;
    }

    /* begin */
    if (head == SYM_BEGIN) {
        Value *a; int na = value_to_list(args, &a);
        if (na == 0) { code_emit(code, OP_VOID, VAL_NIL); ul_free(a); return; }
        for (int i = 0; i < na - 1; i++) { bc_compile(a[i], code, env, false); code_emit(code, OP_POP, VAL_NIL); }
        bc_compile(a[na-1], code, env, tail);
        ul_free(a); return;
    }

    /* and */
    if (head == SYM_AND) {
        Value *a; int na = value_to_list(args, &a);
        if (na == 0) { code_emit(code, OP_CONST, VAL_TRUE); ul_free(a); return; }
        if (na == 1) { bc_compile(a[0], code, env, tail); ul_free(a); return; }
        int *ends = (int *)ul_malloc(sizeof(int) * na);
        int nends = 0;
        for (int i = 0; i < na - 1; i++) {
            bc_compile(a[i], code, env, false);
            ends[nends++] = code_emit(code, OP_JUMP_IF_FALSE_KEEP, VAL_NIL);
        }
        bc_compile(a[na-1], code, env, tail);
        int end = code->count;
        for (int i = 0; i < nends; i++) code_patch(code, ends[i], VAL_INT(end));
        ul_free(ends); ul_free(a); return;
    }

    /* or */
    if (head == SYM_OR) {
        Value *a; int na = value_to_list(args, &a);
        if (na == 0) { code_emit(code, OP_CONST, VAL_FALSE); ul_free(a); return; }
        if (na == 1) { bc_compile(a[0], code, env, tail); ul_free(a); return; }
        int *ends = (int *)ul_malloc(sizeof(int) * na);
        int nends = 0;
        for (int i = 0; i < na - 1; i++) {
            bc_compile(a[i], code, env, false);
            ends[nends++] = code_emit(code, OP_JUMP_IF_TRUE_KEEP, VAL_NIL);
        }
        bc_compile(a[na-1], code, env, tail);
        int end = code->count;
        for (int i = 0; i < nends; i++) code_patch(code, ends[i], VAL_INT(end));
        ul_free(ends); ul_free(a); return;
    }

    /* when */
    if (head == SYM_WHEN) {
        Value *a; int na = value_to_list(args, &a);
        bc_compile(a[0], code, env, false);
        int jf = code_emit(code, OP_JUMP_IF_FALSE, VAL_NIL);
        for (int i = 1; i < na - 1; i++) { bc_compile(a[i], code, env, false); code_emit(code, OP_POP, VAL_NIL); }
        bc_compile(a[na-1], code, env, tail);
        int je = code_emit(code, OP_JUMP, VAL_NIL);
        code_patch(code, jf, VAL_INT(code->count));
        code_emit(code, OP_VOID, VAL_NIL);
        code_patch(code, je, VAL_INT(code->count));
        ul_free(a); return;
    }

    /* unless */
    if (head == SYM_UNLESS) {
        Value *a; int na = value_to_list(args, &a);
        bc_compile(a[0], code, env, false);
        int jf = code_emit(code, OP_JUMP_IF_FALSE, VAL_NIL);
        code_emit(code, OP_VOID, VAL_NIL);
        int je = code_emit(code, OP_JUMP, VAL_NIL);
        code_patch(code, jf, VAL_INT(code->count));
        for (int i = 1; i < na - 1; i++) { bc_compile(a[i], code, env, false); code_emit(code, OP_POP, VAL_NIL); }
        bc_compile(a[na-1], code, env, tail);
        code_patch(code, je, VAL_INT(code->count));
        ul_free(a); return;
    }

    /* cond */
    if (head == SYM_COND) {
        Value *clauses; int nc = value_to_list(args, &clauses);
        int *ends = (int *)ul_malloc(sizeof(int) * nc);
        int nends = 0;
        for (int i = 0; i < nc; i++) {
            Value *cl; int ncl = value_to_list(clauses[i], &cl);
            if (cl[0] == SYM_ELSE) {
                for (int j = 1; j < ncl - 1; j++) { bc_compile(cl[j], code, env, false); code_emit(code, OP_POP, VAL_NIL); }
                bc_compile(ncl > 1 ? cl[ncl-1] : VAL_VOID, code, env, tail);
                ul_free(cl); break;
            }
            if ((ncl >= 3 && cl[1] == SYM_ARROW) || ncl == 1) {
                /* Fallback for => and bare test */
                code_emit(code, OP_EVAL, expr);
                ul_free(cl); ul_free(ends); ul_free(clauses); return;
            }
            bc_compile(cl[0], code, env, false);
            int jf = code_emit(code, OP_JUMP_IF_FALSE, VAL_NIL);
            for (int j = 1; j < ncl - 1; j++) { bc_compile(cl[j], code, env, false); code_emit(code, OP_POP, VAL_NIL); }
            bc_compile(cl[ncl-1], code, env, tail);
            ends[nends++] = code_emit(code, OP_JUMP, VAL_NIL);
            code_patch(code, jf, VAL_INT(code->count));
            ul_free(cl);
            if (i == nc - 1) code_emit(code, OP_VOID, VAL_NIL);
        }
        int end = code->count;
        for (int i = 0; i < nends; i++) code_patch(code, ends[i], VAL_INT(end));
        ul_free(ends); ul_free(clauses); return;
    }

    /* define */
    if (head == SYM_DEFINE) {
        Value *a; int na = value_to_list(args, &a);
        if (IS_PAIR(a[0])) {
            Value fname = CAR(a[0]);
            Formals f = parse_formals(CDR(a[0]));
            CodeObj *inner = bc_lambda(a + 1, na - 1, f.params, f.nparams, f.rest, env,
                                       sym_name(fname), NULL, NULL, 0);
            /* Emit closure + define */
            /* Pack closure info as a vector: [inner_code, nparams, rest] */
            Value closure_info = make_vector(3, VAL_NIL);
            AS_VECTOR(closure_info)->data[0] = VAL_PTR(inner);
            AS_VECTOR(closure_info)->data[1] = VAL_INT(f.nparams);
            AS_VECTOR(closure_info)->data[2] = f.rest;
            /* Store params in the vector too */
            Value params_vec = make_vector_from(f.params, f.nparams);
            AS_VECTOR(closure_info)->data = (Value *)ul_realloc_values(AS_VECTOR(closure_info)->data, sizeof(Value) * 4);
            AS_VECTOR(closure_info)->len = 4;
            AS_VECTOR(closure_info)->cap = 4;
            AS_VECTOR(closure_info)->data[3] = params_vec;

            code_emit(code, OP_MAKE_CLOSURE, closure_info);
            code_emit(code, OP_DEFINE, fname);
        } else {
            if (na > 1) bc_compile(a[1], code, env, false);
            else code_emit(code, OP_VOID, VAL_NIL);
            code_emit(code, OP_DEFINE, a[0]);
        }
        code_emit(code, OP_VOID, VAL_NIL);
        ul_free(a); return;
    }

    /* set! */
    if (head == SYM_SET) {
        Value *a; int na = value_to_list(args, &a);
        bc_compile(a[1], code, env, false);
        code_emit(code, OP_SET, a[0]);
        code_emit(code, OP_VOID, VAL_NIL);
        ul_free(a); return;
    }

    /* lambda */
    if (head == SYM_LAMBDA || head == SYM_LAMBDA_UC) {
        Value *a; int na = value_to_list(args, &a);
        Formals f = parse_formals(a[0]);
        CodeObj *inner = bc_lambda(a + 1, na - 1, f.params, f.nparams, f.rest, env,
                                   NULL, NULL, NULL, 0);
        Value closure_info = make_vector(4, VAL_NIL);
        AS_VECTOR(closure_info)->data[0] = VAL_PTR(inner);
        AS_VECTOR(closure_info)->data[1] = VAL_INT(f.nparams);
        AS_VECTOR(closure_info)->data[2] = f.rest;
        AS_VECTOR(closure_info)->data[3] = make_vector_from(f.params, f.nparams);
        code_emit(code, OP_MAKE_CLOSURE, closure_info);
        ul_free(a); return;
    }

    /* let */
    if (head == SYM_LET) {
        Value *a; int na = value_to_list(args, &a);
        if (IS_SYM(a[0])) {
            /* Named let */
            Value name = a[0];
            Value *binds; int nb = value_to_list(a[1], &binds);
            Value *bps = (Value *)ul_malloc_values(sizeof(Value) * nb);
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                bps[i] = bp[0];
                ul_free(bp);
            }
            CodeObj *inner = bc_lambda(a + 2, na - 2, bps, nb, VAL_NIL, env,
                                       sym_name(name), sym_name(name), bps, nb);
            code_emit(code, OP_PUSH_ENV, VAL_NIL);
            Value closure_info = make_vector(4, VAL_NIL);
            AS_VECTOR(closure_info)->data[0] = VAL_PTR(inner);
            AS_VECTOR(closure_info)->data[1] = VAL_INT(nb);
            AS_VECTOR(closure_info)->data[2] = VAL_NIL;
            AS_VECTOR(closure_info)->data[3] = make_vector_from(bps, nb);
            code_emit(code, OP_MAKE_CLOSURE, closure_info);
            code_emit(code, OP_DUP, VAL_NIL);
            code_emit(code, OP_BIND, name);
            for (int i = 0; i < nb; i++) {
                Value *bp; int nbp = value_to_list(binds[i], &bp);
                bc_compile(bp[1], code, env, false);
                ul_free(bp);
            }
            code_emit(code, tail ? OP_TAIL_CALL : OP_CALL, VAL_INT(nb));
            if (!tail) code_emit(code, OP_POP_ENV, VAL_NIL);
            ul_free(bps); ul_free(binds); ul_free(a); return;
        }
        /* Regular let */
        Value *binds; int nb = value_to_list(a[0], &binds);
        for (int i = 0; i < nb; i++) {
            Value *bp; int nbp = value_to_list(binds[i], &bp);
            bc_compile(bp[1], code, env, false);
            ul_free(bp);
        }
        code_emit(code, OP_PUSH_ENV, VAL_NIL);
        for (int i = nb - 1; i >= 0; i--) {
            Value *bp; int nbp = value_to_list(binds[i], &bp);
            code_emit(code, OP_BIND, bp[0]);
            ul_free(bp);
        }
        bc_body(a + 1, na - 1, code, env, tail);
        if (!tail) code_emit(code, OP_POP_ENV, VAL_NIL);
        ul_free(binds); ul_free(a); return;
    }

    /* let* */
    if (head == SYM_LET_STAR) {
        Value *a; int na = value_to_list(args, &a);
        Value *binds; int nb = value_to_list(a[0], &binds);
        code_emit(code, OP_PUSH_ENV, VAL_NIL);
        for (int i = 0; i < nb; i++) {
            Value *bp; int nbp = value_to_list(binds[i], &bp);
            bc_compile(bp[1], code, env, false);
            code_emit(code, OP_BIND, bp[0]);
            ul_free(bp);
        }
        bc_body(a + 1, na - 1, code, env, tail);
        if (!tail) code_emit(code, OP_POP_ENV, VAL_NIL);
        ul_free(binds); ul_free(a); return;
    }

    /* letrec / letrec* */
    if (head == SYM_LETREC || head == SYM_LETREC_STAR) {
        Value *a; int na = value_to_list(args, &a);
        Value *binds; int nb = value_to_list(a[0], &binds);
        code_emit(code, OP_PUSH_ENV, VAL_NIL);
        for (int i = 0; i < nb; i++) {
            Value *bp; int nbp = value_to_list(binds[i], &bp);
            code_emit(code, OP_VOID, VAL_NIL);
            code_emit(code, OP_BIND, bp[0]);
            ul_free(bp);
        }
        for (int i = 0; i < nb; i++) {
            Value *bp; int nbp = value_to_list(binds[i], &bp);
            bc_compile(bp[1], code, env, false);
            code_emit(code, OP_SET, bp[0]);
            ul_free(bp);
        }
        bc_body(a + 1, na - 1, code, env, tail);
        if (!tail) code_emit(code, OP_POP_ENV, VAL_NIL);
        ul_free(binds); ul_free(a); return;
    }

    /* do */
    if (head == SYM_DO) {
        Value *a; int na = value_to_list(args, &a);
        Value *vcs; int nvc = value_to_list(a[0], &vcs);
        Value *term; int nterm = value_to_list(a[1], &term);

        /* Initialize vars */
        typedef struct { Value var; Value step; } DoSpec;
        DoSpec *specs = (DoSpec *)ul_malloc_values(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];
            specs[i].step = nsp > 2 ? sp[2] : sp[0];
            bc_compile(sp[1], code, env, false);
            ul_free(sp);
        }
        code_emit(code, OP_PUSH_ENV, VAL_NIL);
        for (int i = nvc - 1; i >= 0; i--) code_emit(code, OP_BIND, specs[i].var);

        int loop_start = code->count;
        bc_compile(term[0], code, env, false);
        int jf = code_emit(code, OP_JUMP_IF_FALSE, VAL_NIL);
        if (nterm > 1) {
            for (int i = 1; i < nterm - 1; i++) { bc_compile(term[i], code, env, false); code_emit(code, OP_POP, VAL_NIL); }
            bc_compile(term[nterm-1], code, env, tail);
        } else {
            code_emit(code, OP_VOID, VAL_NIL);
        }
        int je = code_emit(code, OP_JUMP, VAL_NIL);
        code_patch(code, jf, VAL_INT(code->count));

        /* Body */
        for (int i = 2; i < na; i++) { bc_compile(a[i], code, env, false); code_emit(code, OP_POP, VAL_NIL); }

        /* Steps */
        for (int i = 0; i < nvc; i++) bc_compile(specs[i].step, code, env, false);
        for (int i = nvc - 1; i >= 0; i--) code_emit(code, OP_SET, specs[i].var);
        code_emit(code, OP_JUMP, VAL_INT(loop_start));
        code_patch(code, je, VAL_INT(code->count));
        if (!tail) code_emit(code, OP_POP_ENV, VAL_NIL);

        ul_free(specs); ul_free(vcs); ul_free(term); ul_free(a);
        return;
    }

    /* call/cc */
    if (head == SYM_CALL_CC || head == SYM_CALL_CC2) {
        Value *a; int na = value_to_list(args, &a);
        bc_compile(a[0], code, env, false);
        code_emit(code, OP_CALL_CC, VAL_NIL);
        ul_free(a); return;
    }

    /* apply — fallback to eval */
    if (head == SYM_APPLY) {
        code_emit(code, OP_EVAL, expr); return;
    }

    /* Macro expansion at compile time */
    if (IS_SYM(head)) {
        TRY(ctx) {
            Value hval = env_lookup(env, head);
            if (IS_MACRO(hval)) {
                ULMacro *m = AS_MACRO(hval);
                Value *a; int na = value_to_list(args, &a);
                Value expanded;
                if (IS_SYNTAX_TRANSFORMER(m->transformer)) {
                    Value form = list_to_value(a, na);
                    expanded = syntax_transform_value(AS_SYNTAX_TRANSFORMER(m->transformer), form);
                } else {
                    expanded = call_proc(m->transformer, a, na, env);
                }
                ul_free(a);
                bc_compile(expanded, code, env, tail);
                return;
            }
        } CATCH {
            /* Not found — continue to regular call */
        } ENDTRY;
    }

    /* Specialized opcodes for hot builtins */
    if (IS_SYM(head) && bc_is_global(head, env)) {
        Value *call_args; int nca = value_to_list(args, &call_args);

        /* + with 2 args */
        if (head == intern("+") && nca == 2) {
            /* Check for +1 optimization */
            if (IS_INT(call_args[1]) && as_int(call_args[1]) == 1 && IS_SYM(call_args[0])) {
                code_emit(code, OP_LOOK_ADD1, call_args[0]);
                ul_free(call_args); return;
            }
            if (IS_INT(call_args[0]) && as_int(call_args[0]) == 1 && IS_SYM(call_args[1])) {
                code_emit(code, OP_LOOK_ADD1, call_args[1]);
                ul_free(call_args); return;
            }
            bc_compile(call_args[0], code, env, false);
            bc_compile(call_args[1], code, env, false);
            code_emit(code, OP_ADD, VAL_NIL);
            ul_free(call_args); return;
        }
        /* - with 2 args */
        if (head == intern("-") && nca == 2) {
            if (IS_INT(call_args[1]) && as_int(call_args[1]) == 1 && IS_SYM(call_args[0])) {
                code_emit(code, OP_LOOK_SUB1, call_args[0]);
                ul_free(call_args); return;
            }
            bc_compile(call_args[0], code, env, false);
            bc_compile(call_args[1], code, env, false);
            code_emit(code, OP_SUB, VAL_NIL);
            ul_free(call_args); return;
        }
        if (head == intern("-") && nca == 1) {
            bc_compile(call_args[0], code, env, false);
            code_emit(code, OP_NEG, VAL_NIL);
            ul_free(call_args); return;
        }
        if (head == intern("*") && nca == 2) {
            bc_compile(call_args[0], code, env, false);
            bc_compile(call_args[1], code, env, false);
            code_emit(code, OP_MUL, VAL_NIL);
            ul_free(call_args); return;
        }

        /* Comparison ops */
        #define SPECIALIZE_CMP(sym_str, opcode) \
            if (head == intern(sym_str) && nca == 2) { \
                bc_compile(call_args[0], code, env, false); \
                bc_compile(call_args[1], code, env, false); \
                code_emit(code, opcode, VAL_NIL); \
                ul_free(call_args); return; \
            }
        SPECIALIZE_CMP("=", OP_NUM_EQ)
        SPECIALIZE_CMP("<", OP_LT)
        SPECIALIZE_CMP(">", OP_GT)
        SPECIALIZE_CMP("<=", OP_LE)
        SPECIALIZE_CMP(">=", OP_GE)
        #undef SPECIALIZE_CMP

        /* car, cdr, cons, null?, pair?, not, zero? */
        if (head == intern("car") && nca == 1) {
            bc_compile(call_args[0], code, env, false);
            code_emit(code, OP_CAR, VAL_NIL);
            ul_free(call_args); return;
        }
        if (head == intern("cdr") && nca == 1) {
            bc_compile(call_args[0], code, env, false);
            code_emit(code, OP_CDR, VAL_NIL);
            ul_free(call_args); return;
        }
        if (head == intern("cons") && nca == 2) {
            bc_compile(call_args[0], code, env, false);
            bc_compile(call_args[1], code, env, false);
            code_emit(code, OP_CONS, VAL_NIL);
            ul_free(call_args); return;
        }
        if (head == intern("null?") && nca == 1) {
            bc_compile(call_args[0], code, env, false);
            code_emit(code, OP_NULL_P, VAL_NIL);
            ul_free(call_args); return;
        }
        if (head == intern("pair?") && nca == 1) {
            bc_compile(call_args[0], code, env, false);
            code_emit(code, OP_PAIR_P, VAL_NIL);
            ul_free(call_args); return;
        }
        if (head == intern("not") && nca == 1) {
            bc_compile(call_args[0], code, env, false);
            code_emit(code, OP_NOT, VAL_NIL);
            ul_free(call_args); return;
        }
        if (head == intern("zero?") && nca == 1) {
            bc_compile(call_args[0], code, env, false);
            code_emit(code, OP_ZERO_P, VAL_NIL);
            ul_free(call_args); return;
        }

        ul_free(call_args);
    }

    /* Self tail-call optimization */
    if (tail && IS_SYM(head) && code->self_name && strcmp(sym_name(head), code->self_name) == 0) {
        Value *call_args; int nca = value_to_list(args, &call_args);
        for (int i = 0; i < nca; i++) bc_compile(call_args[i], code, env, false);
        /* 2026-06-14 frame-unwind: pops accumulated let/let-star/letrec/do
           frames before we reuse our lambda body env. arg2 now carries
           pops_needed (was self_nparams, redundant since cur_code knows it). */
        int pops_needed = code->scope_depth - code->self_base;
        code_emit2(code, OP_SELF_TAIL_CALL, VAL_INT(nca), pops_needed);
        ul_free(call_args); return;
    }

    /* Regular function call */
    bc_compile(head, code, env, false);
    Value *call_args; int nca = value_to_list(args, &call_args);
    for (int i = 0; i < nca; i++) bc_compile(call_args[i], code, env, false);
    code_emit(code, tail ? OP_TAIL_CALL : OP_CALL, VAL_INT(nca));
    ul_free(call_args);
}

/* syntax_transform_value is declared in lumbda.h, implemented in eval.c */

/* ═══════════════════════════════════════════════════════════════════════════
 * Compile a Proc into a CompiledProc
 * ═══════════════════════════════════════════════════════════════════════════ */

CompiledProc *compile_proc(Proc *p, Env *env) {
    CodeObj *code = bc_lambda(p->body.exprs, p->body.count,
                              p->params, p->nparams, p->rest, env,
                              p->name, NULL, NULL, 0);
    CompiledProc *cp = (CompiledProc *)ul_malloc_values(sizeof(CompiledProc));
    cp->hdr.type = OBJ_COMPILED_PROC;
    cp->code = code;
    cp->params = (Value *)ul_malloc_values(sizeof(Value) * p->nparams);
    memcpy(cp->params, p->params, sizeof(Value) * p->nparams);
    cp->nparams = p->nparams;
    cp->rest = p->rest;
    cp->env = p->env;
    cp->name = p->name ? ul_strdup(p->name) : NULL;
    return cp;
}

/* ═══════════════════════════════════════════════════════════════════════════
 * VM execution
 * ═══════════════════════════════════════════════════════════════════════════ */

/* Invoke a FullCont — signals the VM trampoline via longjmp */
static Value invoke_continuation(FullCont *cont, Value val) {
    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);
    return VAL_VOID; /* unreachable */
}

/* Builtin wrapper for calling a continuation as a function */
static Value cont_call_builtin(Value *args, int nargs, Env *env) {
    (void)env;
    /* The continuation value is stored as the first arg; we passed it differently.
     * Actually, we need to find the continuation. The trick: we use the eval.c
     * call path which checks IS_CONTINUATION. So this path is only for when
     * continuations end up in the generic builtin slot (which won't happen). */
    lisp_error("continuation called through wrong path");
    return VAL_VOID;
}

Value vm_exec(CodeObj *code, Env *env) {
    CodeObj *cur_code = code;
    Instruction *instrs = code->instrs;
    int ip = 0;
    int n_instrs = code->count;

    ValueStack stack;
    vs_init(&stack, 128);

    /* Frame stack */
    int frame_cap = 32;
    int frame_count = 0;
    VMFrame *frames = (VMFrame *)ul_malloc(sizeof(VMFrame) * frame_cap);

    /* Unique ID for this VM invocation (used to match continuations) */
    int vm_id_storage;
    void *vm_id = &vm_id_storage;

    /* Set up trampoline for continuation invocation */
    ContTrampoline trampoline;
    trampoline.active = true;
    ContTrampoline *prev_trampoline = g_cont_trampoline;
    g_cont_trampoline = &trampoline;

    if (setjmp(trampoline.jmp) != 0) {
        /* A continuation was invoked — resume it */
        FullCont *c = g_cont_invoked;
        Value val = g_cont_invoked_val;
        g_cont_invoked = NULL;

        /* Deep-copy the continuation state for multi-shot safety */
        frame_count = c->nframes;
        if (frame_count > frame_cap) {
            frame_cap = frame_count * 2;
        }
        ul_free(frames);
        frames = deep_copy_frames(c->frames, c->nframes);
        frame_cap = frame_count > 0 ? frame_count * 2 : 32;

        ul_free(stack.data);
        stack.len = c->stack_len;
        stack.cap = c->stack_len + 16;
        stack.data = (Value *)ul_malloc_values(sizeof(Value) * stack.cap);
        memcpy(stack.data, c->stack, sizeof(Value) * c->stack_len);
        vs_push(&stack, val);

        ip = c->ip;
        instrs = c->instrs;
        n_instrs = c->n_instrs;
        env = deep_copy_env(c->env);
        /* Fall through to main loop */
    }

    while (ip < n_instrs) {
        Instruction *instr = &instrs[ip++];
        Opcode op = instr->op;
        Value arg = instr->arg;

        switch (op) {
        case OP_CONST:
            vs_push(&stack, arg);
            break;
        case OP_LOOKUP:
            vs_push(&stack, env_lookup(env, arg));
            break;
        case OP_SET:
            env_set(env, arg, vs_pop(&stack));
            break;
        case OP_DEFINE:
            env_define(env, arg, vs_pop(&stack));
            break;
        case OP_POP:
            vs_pop(&stack);
            break;
        case OP_DUP:
            vs_push(&stack, vs_peek(&stack));
            break;
        case OP_VOID:
            vs_push(&stack, VAL_VOID);
            break;
        case OP_JUMP:
            ip = (int)as_int(arg);
            if (g_portal_checkpoint_path) {
                FullCont *cp_cont = make_full_cont(frames, frame_count,
                    stack.data, stack.len, ip, instrs, n_instrs, env, vm_id);
                portal_save(env, g_portal_checkpoint_path, cp_cont);
                ul_free((void *)g_portal_checkpoint_path);
                g_portal_checkpoint_path = NULL;
            }
            break;
        case OP_JUMP_IF_FALSE: {
            Value v = vs_pop(&stack);
            if (IS_FALSE(v)) ip = (int)as_int(arg);
            break;
        }
        case OP_JUMP_IF_FALSE_KEEP:
            if (IS_FALSE(stack.data[stack.len - 1])) ip = (int)as_int(arg);
            else vs_pop(&stack);
            break;
        case OP_JUMP_IF_TRUE_KEEP:
            if (IS_TRUTHY(stack.data[stack.len - 1])) ip = (int)as_int(arg);
            else vs_pop(&stack);
            break;
        case OP_CALL: {
            int nargs = (int)as_int(arg);
            Value *args_arr = stack.data + stack.len - nargs;
            stack.len -= nargs;
            Value func = vs_pop(&stack);

            if (IS_CONTINUATION(func)) {
                Value val = nargs > 0 ? args_arr[0] : VAL_VOID;
                invoke_continuation(AS_CONTINUATION(func), val);
                break; /* unreachable */
            }
            if (IS_COMPILED_PROC(func)) {
                CompiledProc *cp = AS_COMPILED_PROC(func);
                /* Push frame */
                if (frame_count >= frame_cap) {
                    frame_cap *= 2;
                    frames = (VMFrame *)ul_realloc(frames, sizeof(VMFrame) * frame_cap);
                }
                VMFrame *f = &frames[frame_count++];
                f->instrs = instrs; f->ip = ip; f->n_instrs = n_instrs;
                f->env = env;
                f->stack = stack.data; f->stack_len = stack.len; f->stack_cap = stack.cap;
                f->cur_code = cur_code;

                env = env_child(cp->env, cp->params, cp->nparams, cp->rest, args_arr, nargs);
                cur_code = cp->code;
                instrs = cp->code->instrs; ip = 0; n_instrs = cp->code->count;
                vs_init(&stack, 64);
                continue;
            }
            if (IS_PROC(func)) {
                vs_push(&stack, call_proc(func, args_arr, nargs, env));
            } else if (IS_BUILTIN(func)) {
                vs_push(&stack, AS_BUILTIN(func)(args_arr, nargs, env));
            } else {
                lisp_error("not callable");
            }
            break;
        }
        case OP_TAIL_CALL: {
            int nargs = (int)as_int(arg);
            Value *args_arr = stack.data + stack.len - nargs;
            stack.len -= nargs;
            Value func = vs_pop(&stack);

            if (IS_CONTINUATION(func)) {
                Value val = nargs > 0 ? args_arr[0] : VAL_VOID;
                invoke_continuation(AS_CONTINUATION(func), val);
                break; /* unreachable */
            }
            if (IS_COMPILED_PROC(func)) {
                CompiledProc *cp = AS_COMPILED_PROC(func);
                env = env_child(cp->env, cp->params, cp->nparams, cp->rest, args_arr, nargs);
                cur_code = cp->code;
                instrs = cp->code->instrs; ip = 0; n_instrs = cp->code->count;
                vs_clear(&stack);
                if (g_portal_checkpoint_path) {
                    FullCont *cp_cont = make_full_cont(frames, frame_count,
                        stack.data, stack.len, ip, instrs, n_instrs, env, vm_id);
                    portal_save(env, g_portal_checkpoint_path, cp_cont);
                    ul_free((void *)g_portal_checkpoint_path);
                    g_portal_checkpoint_path = NULL;
                }
                continue;
            }
            if (IS_PROC(func) || IS_BUILTIN(func)) {
                Value ret = call_proc(func, args_arr, nargs, env);
                if (frame_count == 0) { ul_free(frames); ul_free(stack.data); g_cont_trampoline = prev_trampoline; return ret; }
                VMFrame *f = &frames[--frame_count];
                instrs = f->instrs; ip = f->ip; n_instrs = f->n_instrs;
                env = f->env;
                ul_free(stack.data);
                stack.data = f->stack; stack.len = f->stack_len; stack.cap = f->stack_cap;
                cur_code = f->cur_code;
                vs_push(&stack, ret);
                continue;
            }
            lisp_error("not callable");
            break;
        }
        case OP_RETURN: {
            Value ret = stack.len > 0 ? vs_pop(&stack) : VAL_VOID;
            if (frame_count == 0) { ul_free(frames); ul_free(stack.data); g_cont_trampoline = prev_trampoline; return ret; }
            VMFrame *f = &frames[--frame_count];
            instrs = f->instrs; ip = f->ip; n_instrs = f->n_instrs;
            env = f->env;
            ul_free(stack.data);
            stack.data = f->stack; stack.len = f->stack_len; stack.cap = f->stack_cap;
            cur_code = f->cur_code;
            vs_push(&stack, ret);
            continue;
        }
        case OP_MAKE_CLOSURE: {
            /* arg is a vector: [code, nparams, rest, params_vec] */
            ULVector *info = AS_VECTOR(arg);
            CodeObj *inner = AS_CODE(info->data[0]);
            int nparams = (int)as_int(info->data[1]);
            Value rest = info->data[2];
            ULVector *params_vec = AS_VECTOR(info->data[3]);

            CompiledProc *cp = (CompiledProc *)ul_malloc_values(sizeof(CompiledProc));
            cp->hdr.type = OBJ_COMPILED_PROC;
            cp->code = inner;
            cp->params = params_vec->data;
            cp->nparams = nparams;
            cp->rest = rest;
            cp->env = env;
            cp->name = inner->name;
            vs_push(&stack, VAL_PTR(cp));
            break;
        }
        case OP_PUSH_ENV:
            env = make_env(env);
            break;
        case OP_POP_ENV:
            env = env->parent;
            break;
        case OP_BIND:
            env_define(env, arg, vs_pop(&stack));
            break;
        case OP_EVAL:
            vs_push(&stack, leval(arg, env));
            break;
        case OP_CALL_CC:
            /* Full call/cc — capture current VM state as a FullCont */
            {
                Value proc = vs_pop(&stack);
                FullCont *cont = make_full_cont(frames, frame_count,
                    stack.data, stack.len, ip, instrs, n_instrs, env, vm_id);
                Value cont_val = VAL_PTR(cont);

                if (IS_COMPILED_PROC(proc)) {
                    /* Push frame and enter compiled proc with continuation as arg */
                    CompiledProc *cp = AS_COMPILED_PROC(proc);
                    if (frame_count >= frame_cap) {
                        frame_cap *= 2;
                        frames = (VMFrame *)ul_realloc(frames, sizeof(VMFrame) * frame_cap);
                    }
                    VMFrame *f = &frames[frame_count++];
                    f->instrs = instrs; f->ip = ip; f->n_instrs = n_instrs;
                    f->env = env;
                    f->stack = stack.data; f->stack_len = stack.len; f->stack_cap = stack.cap;
                    f->cur_code = cur_code;
                    Value kargs[1] = {cont_val};
                    env = env_child(cp->env, cp->params, cp->nparams, cp->rest, kargs, 1);
                    cur_code = cp->code;
                    instrs = cp->code->instrs; ip = 0; n_instrs = cp->code->count;
                    vs_init(&stack, 64);
                    continue;
                }
                if (IS_PROC(proc) || IS_BUILTIN(proc)) {
                    Value kargs[1] = {cont_val};
                    vs_push(&stack, call_proc(proc, kargs, 1, env));
                } else {
                    lisp_error("call/cc: not callable");
                }
            }
            break;

        /* Specialized opcodes */
        case OP_ADD: { Value b = vs_pop(&stack); stack.data[stack.len-1] = num_add(stack.data[stack.len-1], b); break; }
        case OP_SUB: { Value b = vs_pop(&stack); stack.data[stack.len-1] = num_sub(stack.data[stack.len-1], b); break; }
        case OP_MUL: { Value b = vs_pop(&stack); stack.data[stack.len-1] = num_mul(stack.data[stack.len-1], b); break; }
        case OP_NEG: stack.data[stack.len-1] = num_neg(stack.data[stack.len-1]); break;
        case OP_ADD1: stack.data[stack.len-1] = num_add(stack.data[stack.len-1], VAL_INT(1)); break;
        case OP_SUB1: stack.data[stack.len-1] = num_sub(stack.data[stack.len-1], VAL_INT(1)); break;
        case OP_NUM_EQ: { Value b = vs_pop(&stack); stack.data[stack.len-1] = VAL_BOOL(num_eq(stack.data[stack.len-1], b)); break; }
        case OP_LT: { Value b = vs_pop(&stack); stack.data[stack.len-1] = VAL_BOOL(num_lt(stack.data[stack.len-1], b)); break; }
        case OP_GT: { Value b = vs_pop(&stack); stack.data[stack.len-1] = VAL_BOOL(num_gt(stack.data[stack.len-1], b)); break; }
        case OP_LE: { Value b = vs_pop(&stack); stack.data[stack.len-1] = VAL_BOOL(num_le(stack.data[stack.len-1], b)); break; }
        case OP_GE: { Value b = vs_pop(&stack); stack.data[stack.len-1] = VAL_BOOL(num_ge(stack.data[stack.len-1], b)); break; }
        case OP_CAR: stack.data[stack.len-1] = CAR(stack.data[stack.len-1]); break;
        case OP_CDR: stack.data[stack.len-1] = CDR(stack.data[stack.len-1]); break;
        case OP_CONS: { Value d = vs_pop(&stack); stack.data[stack.len-1] = cons(stack.data[stack.len-1], d); break; }
        case OP_NULL_P: stack.data[stack.len-1] = VAL_BOOL(IS_NIL(stack.data[stack.len-1])); break;
        case OP_PAIR_P: stack.data[stack.len-1] = VAL_BOOL(IS_PAIR(stack.data[stack.len-1])); break;
        case OP_NOT: stack.data[stack.len-1] = VAL_BOOL(IS_FALSE(stack.data[stack.len-1])); break;
        case OP_ZERO_P: stack.data[stack.len-1] = VAL_BOOL(num_eq(stack.data[stack.len-1], VAL_INT(0))); break;
        case OP_VEC_REF: { Value i = vs_pop(&stack); stack.data[stack.len-1] = AS_VECTOR(stack.data[stack.len-1])->data[(int)as_int(i)]; break; }
        case OP_VEC_SET: { Value v = vs_pop(&stack); Value i = vs_pop(&stack); AS_VECTOR(stack.data[stack.len-1])->data[(int)as_int(i)] = v; stack.data[stack.len-1] = VAL_VOID; break; }

        /* Superinstructions */
        case OP_LOOK_ADD1: vs_push(&stack, num_add(env_lookup(env, arg), VAL_INT(1))); break;
        case OP_LOOK_SUB1: vs_push(&stack, num_sub(env_lookup(env, arg), VAL_INT(1))); break;
        case OP_SELF_TAIL_CALL: {
            int nargs = (int)as_int(arg);
            int pops = instr->arg2;
            Value *args_arr = stack.data + stack.len - nargs;
            /* 2026-06-14 frame-unwind: pop let/let-star/letrec/do frames
               accumulated since lambda body entry. Otherwise env grows
               per iter & every var lookup walks an O(n) chain. */
            while (pops > 0 && env->parent) {
                env = env->parent;
                pops--;
            }
            /* Rebind in lambda body env (post-unwind) */
            if (cur_code->self_params) {
                for (int i = 0; i < nargs && i < cur_code->self_nparams; i++) {
                    env_set(env, cur_code->self_params[i], args_arr[i]);
                }
            }
            ip = 0;
            vs_clear(&stack);
            continue;
        }
        default:
            lisp_error("unknown opcode: %d", op);
        }
    }

    Value ret = stack.len > 0 ? stack.data[stack.len - 1] : VAL_VOID;
    ul_free(stack.data);
    ul_free(frames);
    g_cont_trampoline = prev_trampoline;
    return ret;
}