thesis-lisp/compiler/compile.c

#include "builtin.h"
#include "compile.h"
#include "unit.h"
#include "node.h"
#include "op.h"

#include <string.h>
#include <stdio.h>

int emit_arg_list(struct function *fn, struct context *ctx, struct node *expr) {
    if (!expr) {
        return 0;
    }
    assert(expr->type == N_CONS);
    int e = emit_arg_list(fn, ctx, expr->n_cons.cdr);
    emit(fn, ctx, expr->n_cons.car);
    return e + 1;
}

void emit_function(struct context *ctx, struct function *fn) {
    struct node *body = fn->body;
    struct unit *root = ctx->root;
    assert(ctx->owner == fn);

    fn->argc = 0;
    for (struct node *node = fn->args; node; node = cdr(node)) {
        ++fn->argc;
    }

    // Pass 0 - extract global scope
    for (struct node *node = body; node; node = cdr(node)) {
        struct node *expr = car(node);

        if (pair_q(expr)) {
            struct node *v0;
            struct node *op = car(expr);
            if (ident_q(op)) {
                if (!strcmp(op->n_ident, "define")) {
                    v0 = cadr(expr);
                    if (ident_q(v0)) {
                        hash_insert(&ctx->vars, v0->n_ident, (void *) ctx->var_counter++);
                    } else if (cons_q(v0)) {
                        v0 = car(v0);
                        assert(ident_q(v0));
                        hash_insert(&ctx->vars, v0->n_ident, (void *) ctx->var_counter++);
                    } else {
                        printf("Unexpected expression: ");
                        vm_print(expr, 0);
                        printf("\n");
                        abort();
                    }
                } else if (!strcmp(op->n_ident, "use")) {
                    v0 = cadr(expr);
                    assert(ident_q(v0));
                    // TODO `use`s should be local to their contexts
                    if (unit_ext_load(root, v0->n_ident) != 0) {
                        assert(0 && "Failed to load external unit\n");
                    }
                }
            }
        }
    }

    // Pass 1 - emit code
    // Emit entry
    for (struct node *node = body; node; node = cdr(node)) {
        struct node *expr = car(node);
        emit(fn, ctx, expr);
    }
    // Obligatory program return
    emit_insn(fn, OP(OP_RET, 0));

    if (ctx->parent) {
        fn->local_count = ctx->var_counter;
    } else {
        // Root function
        fn->local_count = 0;
    }
}

void emit_store(struct function *fn, int kind, size_t index) {
    switch (kind) {
    case NAME_LOCAL:
        emit_insn(fn, OP(OP_STL, index));
        break;
    case NAME_GLOBAL:
        emit_insn(fn, OP(OP_STG, index));
        break;
    case NAME_ARGUMENT:
        emit_insn(fn, OP(OP_STARG, index));
        break;
    default:
        abort();
    }
}

void emit_call(struct function *fn, struct context *ctx, const char *name) {
    size_t index;
    int kind;

    if (ctx_lookup_name(ctx, name, &kind, &index) != 0) {
        printf("Undefined reference to function %s\n", name);
        abort();
    }

    switch (kind) {
    case NAME_EXTERNAL:
        emit_insn(fn, OP(OP_XCALL, index));
        break;
    case NAME_LOCAL:
        emit_insn(fn, OP(OP_LDL, index));
        emit_insn(fn, OP(OP_CALL, 0));
        break;
    case NAME_ARGUMENT:
        emit_insn(fn, OP(OP_LDARG, index));
        emit_insn(fn, OP(OP_CALL, 0));
        break;
    case NAME_GLOBAL:
        emit_insn(fn, OP(OP_GCALL, index));
        break;
    default:
        printf("Unknown %d\n", kind);
        abort();
    }
}

void emit(struct function *fn, struct context *ctx, struct node *expr) {
    if (!expr) {
        return;
    }
    struct node *n0;
    size_t index;
    int c0;

    switch (expr->type) {
    case N_CONS:
        // Cons chain root - function call
        n0 = expr->n_cons.car;

        if (!n0) {
            fprintf(stderr, "Call to nil\n");
            abort();
        }

        if (n0->type == N_IDENT) {
            // Try builtin syntax construct
            if (emit_builtin_syntax(fn, ctx, n0->n_ident, cdr(expr)) == 0) {
                return;
            }

            c0 = emit_arg_list(fn, ctx, expr->n_cons.cdr);

            // Try builtin operator
            if (emit_builtin_insn(fn, n0->n_ident, c0) == 0) {
                return;
            }

            // If everything else failed, try to resolve this as a function
            // call
            emit_call(fn, ctx, n0->n_ident);
            return;
        } else {
            c0 = emit_arg_list(fn, ctx, expr->n_cons.cdr);
            emit(fn, ctx, n0);
            emit_insn(fn, OP(OP_CALL, 0));
            return;
        }
    case N_STRING:
        assert(unit_insert_string(ctx->root, expr->n_string, &index) == 0);
        emit_insn(fn, OP(OP_LDS, index));
        return;
    case N_INTEGER:
        if (expr->n_integer < 0x7FFFFF && expr->n_integer > -0x7FFFFF) {
            emit_insn(fn, OP(OP_LDI, expr->n_integer));
        } else {
            assert(0 && "TODO constant pool lmao");
        }
        return;
    case N_IDENT:
        if (!strcmp(expr->n_ident, "nil")) {
            emit_insn(fn, OP(OP_LDNIL, 0));
        } else if (!strcmp(expr->n_ident, "t")) {
            emit_insn(fn, OP(OP_LDI, 1));
        } else {
            int kind;
            size_t index;

            if (ctx_lookup_name(ctx, expr->n_ident, &kind, &index) != 0) {
                printf("Unresolved reference to: ");
                vm_print(expr, 0);
                printf("\n");
                abort();
            }

            switch (kind) {
            case NAME_GLOBAL:
                emit_insn(fn, OP(OP_LDG, index));
                break;
            case NAME_ARGUMENT:
                emit_insn(fn, OP(OP_LDARG, index));
                break;
            case NAME_LOCAL:
                emit_insn(fn, OP(OP_LDL, index));
                break;
            default:
                abort();
            }
        }
        return;
    default:
        printf("Unexpected value: ");
        vm_print(expr, 0);
        printf("\n");
        abort();
    }
}