thesis-lisp/compiler/unit.c

#include "parse.h"
#include "unit.h"
#include "node.h"

#include <string.h>
#include <stdlib.h>
#include <assert.h>
#include <errno.h>
#include <stdio.h>

static struct ext_unit_entry u_core_entries[] = {
    { "print" },
    { "file-open" },
    { "file-read" },
    { "file-write" },
    { "file-close" },
    { "file-seek" },
    { "exit" }
};

void unit_init(struct unit *u) {
    shash_init(&u->global.vars, 16);
    u->global.root = u;
    u->global.parent = NULL;

    vector_init(&u->functions, sizeof(struct function));
    vector_init(&u->ext_refs, sizeof(struct ext_ref));
    vector_init(&u->ext_units, sizeof(struct ext_unit));
}

void ctx_init(struct context *ctx, struct context *parent) {
    ctx->root = parent->root;
    ctx->parent = parent;
    shash_init(&ctx->vars, 16);
}

struct function *unit_lambda(struct unit *u) {
    size_t index = u->functions.size;
    struct function *f = vector_append(&u->functions);
    f->index = index;
    vector_init(&f->bytecode, sizeof(uint32_t));
    return f;
}

void emit_insn(struct function *fn, uint32_t insn) {
    uint32_t *p = vector_append(&fn->bytecode);
    *p = insn;
}

// TODO non-builtin units
static FILE *unit_try_open_in(const char *paths, const char *name) {
    const char *head;
    char path[256];
    FILE *fp;

    head = paths;

    while (head) {
        // strchrnul emulation
        const char *end = strchr(head, ':');
        size_t len;
        if (end) {
            len = end - head;
        } else {
            len = strlen(head);
        }
        strncpy(path, head, len);
        snprintf(path + len, sizeof(path) - len, "/%s.vmx", name);

        if ((fp = fopen(path, "rb")) != NULL) {
            return fp;
        }

        if (!end) {
            break;
        }
        head = end + 1;
    }
    return NULL;
}

FILE *unit_try_open(const char *name) {
    static const char *const st_path = "/usr/lib/l2:/usr/local/lib/l2";
    const char *env_path = getenv("L2PATH");
    FILE *fp;
    char path[256];

    snprintf(path, sizeof(path), "./%s.vmx", name);

    // Try current dir
    if ((fp = fopen(path, "rb")) != NULL) {
        return fp;
    }
    if ((fp = unit_try_open_in(env_path, name)) != NULL) {
        return fp;
    }
    return unit_try_open_in(st_path, name);
}

static int parse_exports(FILE *fp, struct ext_unit *unit) {
    struct node *unit_text;
    unit_text = vm_load_file(fp);
    assert(unit_text);

    vector_init(&unit->exports, sizeof(struct ext_unit_entry));

    for (struct node *item = unit_text; item; item = cdr(item)) {
        struct node *expr = car(item);

        if (pair_q(expr)) {
            struct node *name = car(expr);
            if (ident_q(name) && !strcmp(name->n_ident, "export")) {
                for (struct node *export_item = cdr(expr); export_item; export_item = cdr(export_item)) {
                    struct node *export = car(export_item);
                    assert(ident_q(export));
                    assert(strlen(export->n_ident) < 64);
                    struct ext_unit_entry *ent = vector_append(&unit->exports);
                    strcpy(ent->name, export->n_ident);
                }
            }
        }
    }

    return 0;
}

int unit_ext_load(struct unit *self, const char *name) {
    if (!strcmp(name, "core")) {
        struct ext_unit *unit = vector_append(&self->ext_units);
        unit->exports.size = sizeof(u_core_entries) / sizeof(u_core_entries[0]);
        unit->exports.cap = unit->exports.size;
        unit->exports.data = u_core_entries;
        strcpy(unit->name, name);
        return 0;
    }

    // Not a builtin, try loading
    FILE *fp = unit_try_open(name);
    if (fp) {
        struct ext_unit *unit = vector_append(&self->ext_units);
        strcpy(unit->name, name);
        parse_exports(fp, unit);
        fclose(fp);
        return 0;
    }

    return -ENOENT;
}

// TODO external references
int ctx_lookup_name(struct context *ctx, const char *name, int *kind, size_t *index) {
    // 1. Lookup local
    struct hash_pair *p;
    p = hash_lookup(&ctx->vars, name);
    if (p) {
        if (ctx->parent) {
            *kind = NAME_LOCAL;
        } else {
            *kind = NAME_GLOBAL;
        }
        *index = (size_t) p->value;
        return 0;
    }

    // 2. Lookup argument
    assert(ctx->owner);
    size_t arg_i = 0;
    for (struct node *node = ctx->owner->args; node; node = cdr(node), ++arg_i) {
        struct node *arg = car(node);
        assert(ident_q(arg));
        if (!strcmp(arg->n_ident, name)) {
            *kind = NAME_ARGUMENT;
            *index = arg_i;
            return 0;
        }
    }

    // 3. Lookup external
    struct unit *root = ctx->root;

    // Try looking up an existing reference entry
    for (size_t i = 0; i < root->ext_refs.size; ++i) {
        struct ext_ref *ref = vector_ref(&root->ext_refs, i);
        if (!strcmp(name, ref->name)) {
            *index = i;
            return 0;
        }
    }

    // Lookup the name in external units
    for (size_t i = 0; i < root->ext_units.size; ++i) {
        struct ext_unit *unit = vector_ref(&root->ext_units, i);
        for (size_t j = 0; j < unit->exports.size; ++j) {
            struct ext_unit_entry *ent = vector_ref(&unit->exports, j);

            if (!strcmp(ent->name, name)) {
                *kind = NAME_EXTERNAL;
                *index = root->ext_refs.size;
                struct ext_ref *ref = vector_append(&root->ext_refs);
                ref->unit_index = i;
                ref->entry_index = j;
                strcpy(ref->name, name);
                return 0;
            }
        }
    }

    if (ctx->parent) {
        return ctx_lookup_name(ctx->parent, name, kind, index);
    }
    return -ENOENT;
}