moka/lib/moka.c

#include "moka.h"
#include "node.h"
#include "compiler.h"
#include "prog.h"
#include "exec.h"
#include "module.h"

void moka_mod_init(struct moka_mod* self,
                   char const* name,
                   struct module* new_module)
{
    assert(self);
    self->name = strdup(name);
    self->module = new_module;
}

void moka_mod_free(struct moka_mod* self)
{
    free(self->name);
    module_free(self->module);
    free(self->module);
}

void moka_init(struct moka* self, struct status* status)
{
    assert(self);
    self->status = status;
    symtable_init(&self->symtable);
    vec_init(&self->frame_stack);
    vec_init(&self->global_values);
    vec_init(&self->modules);

    struct frame* frame = malloc(sizeof(struct frame));
    frame_init(frame);
    vec_push(&self->frame_stack, frame);
}

void frame_init(struct frame* self)
{
    vec_init(&self->local_values);
    vec_init(&self->stack);
}

void frame_free(struct frame* self)
{
    assert(self);
    vec_free_elements(&self->local_values, (void*)value_free);
    vec_free(&self->local_values);
    vec_free(&self->stack);
}

void moka_free(struct moka* self)
{
    assert(self);
    symtable_free(&self->symtable);
    vec_free_elements(&self->frame_stack, (void*) frame_free);
    vec_free(&self->frame_stack);

    vec_free_elements(&self->modules, (void*) moka_mod_free);
    vec_free(&self->modules);

    vec_free_elements(&self->global_values, (void*) value_free);
    vec_free(&self->global_values);
}

void moka_import_module(struct moka* self,
                        char const* name,
                        struct module* module)
{
    assert(self);
    assert(name);
    assert(module);

    struct symtable* mod_sym = &module->moka.symtable;
    struct env* env = mod_sym->root;

    struct frame* mod_frame = moka_frame(&module->moka);
    struct vec* mod_locals = &mod_frame->local_values;
    struct vec* mod_globals = &module->moka.global_values;

    for (size_t i=0; i<env->entries.size; i++)
    {
        struct entry const* entry = env->entries.data[i];
        struct value* val;
        if (entry->is_local)
        {
            val = mod_locals->data[entry->addr];
        }
        else
        {
            val = mod_globals->data[entry->addr];
        }

        char new_name[MK_STRLEN];
        snprintf(new_name, MK_STRLEN, "%s::%s", name, entry->name);

        switch (val->type)
        {
            case TY_NATIVE: {
                moka_decl_native(
                    self,
                    new_name,
                    val->data.native->fun,
                    val->data.native->arity
                );
            } break;

            case TY_SYMBOL: {
                moka_decl_var(
                    self,
                    new_name,
                    moka_push_symbol(self,
                                     val->data.sym,
                                     val->line));
            } break;

            case TY_STRING: {
                moka_decl_var(
                    self,
                    new_name,
                    moka_push_string(self,
                                     val->data.str,
                                     val->line));
            } break;

            case TY_INT: {
                moka_decl_var(
                    self,
                    new_name,
                    moka_push_int(self,
                                  val->data.integer,
                                  val->line));
            } break;

            default: {
                fprintf(stderr,
                        "cannot import value of type <%s>\n",
                        TypeKindStr[val->type]);
                abort();
            } break;
        }

    }

    struct moka_mod* mod = malloc(sizeof(struct moka_mod));
    moka_mod_init(mod, (char*) name, module);

    vec_push(&self->modules, mod);
}

struct module* moka_try_get_module(struct moka* self,
                                   char const* name)
{
    assert(self);
    assert(name);

    for (size_t i=0; i<self->modules.size; i++)
    {
        struct moka_mod* mod = self->modules.data[i];

        if (strcmp(name, mod->name))
        {
            return mod->module;
        }
    }

    return NULL;
}

void moka_decl_var(struct moka* self,
                   char* name,
                   MOKA value)
{
    assert(self); assert(name);

    symtable_declare(
        &self->symtable,
        name,
        value,
        true);
}

void moka_decl_native(struct moka* self,
                      char* name,
                      native_fun_t fun,
                      int arity)
{
    struct native* native = malloc(sizeof(struct native));
    native_init(native, fun, arity);

    struct value* value = malloc(sizeof(struct value));
    value_init_native(value, native, 0);

    vec_push(&self->global_values, value);
    size_t addr = self->global_values.size - 1;

    symtable_declare(&self->symtable, name, addr, false);
}

struct frame* moka_frame(struct moka* self)
{
    assert(self);
    assert(self->frame_stack.size > 0);
    return self->frame_stack.data[
        self->frame_stack.size - 1
    ];
}

bool moka_has_top(struct moka* self)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    return frame->stack.size > 0;
}

MOKA moka_top(struct moka* self)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    assert(frame->stack.size > 0);
    MOKA val = (MOKA) frame->stack.data[frame->stack.size - 1];
    return val;
}

MOKA moka_pop(struct moka* self)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    assert(frame->stack.size > 0);
    MOKA val = (MOKA) frame->stack.data[frame->stack.size - 1];
    vec_pop(&frame->stack);
    return val;
}

int moka_line(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value const* val = frame->local_values.data[value];
    return val->line;
}

size_t moka_str(struct moka* self, MOKA value,
                char* buffer, size_t size)
{
    struct frame* frame = moka_frame(self);
    struct value* val = frame->local_values.data[value];

    if (moka_is(self, value, TY_REF))
    {
        val = self->global_values.data[val->data.ref];
    }

    return value_str(val, buffer, size, self);
}

bool moka_is_lt(struct moka* self, MOKA mk_lhs, MOKA mk_rhs)
{
    struct frame* frame = moka_frame(self);
    struct value* lhs = frame->local_values.data[mk_lhs];
    struct value* rhs = frame->local_values.data[mk_rhs];

    if (lhs->type != rhs->type)
    {
        return false;
    }

    switch (lhs->type)
    {
        case TY_INT: {
            return lhs->data.integer < rhs->data.integer;
        } break;
        case TY_FLOAT: {
            return lhs->data.real < rhs->data.real;
        } break;
        default: {
            fprintf(stderr, "cannot compare type <%s>\n",
                    TypeKindStr[lhs->type]);
            abort();
        } break;
    }
}

bool moka_is_gt(struct moka* self, MOKA mk_lhs, MOKA mk_rhs)
{
    struct frame* frame = moka_frame(self);
    struct value* lhs = frame->local_values.data[mk_lhs];
    struct value* rhs = frame->local_values.data[mk_rhs];

    if (lhs->type != rhs->type)
    {
        return false;
    }

    switch (lhs->type)
    {
        case TY_INT: {
            return lhs->data.integer > rhs->data.integer;
        } break;
        case TY_FLOAT: {
            return lhs->data.real > rhs->data.real;
        } break;
        default: {
            fprintf(stderr, "cannot compare type <%s>\n",
                    TypeKindStr[lhs->type]);
            abort();
        } break;
    }
}

bool moka_is_eqv(struct moka* self, MOKA mk_lhs, MOKA mk_rhs)
{
    struct frame* frame = moka_frame(self);
    struct value* lhs = frame->local_values.data[mk_lhs];
    struct value* rhs = frame->local_values.data[mk_rhs];

    if (lhs->type != rhs->type)
    {
        return false;
    }

    if (moka_is(self, mk_lhs, TY_REF))
    {
        lhs = self->global_values.data[lhs->data.ref];
        rhs = self->global_values.data[rhs->data.ref];
    }

    return value_is_eqv(lhs, rhs, self);
}

MOKA moka_add(struct moka* self, int count)
{
    assert(self);
    struct frame* frame = moka_frame(self);

    float base = 0.0f;
    bool is_int = true;
    int line = 0;

    for (int i=0; i<count; i++)
    {
        MOKA arg = moka_pop(self);

        struct value* value = frame->local_values.data[arg];
        line = value->line;

        if (value->type == TY_INT)
        {
            base += value->data.integer;
        }
        else if (value->type == TY_FLOAT)
        {
            base += value->data.real;
            is_int = false;
        }
    }

    if (is_int)
    {
        return moka_push_int(self, (int) base, line);
    }

    return moka_push_float(self, base, line);
}

MOKA moka_sub(struct moka* self, int count)
{
    assert(self);
    struct frame* frame = moka_frame(self);

    float base = 0.0f;
    bool is_int = true;
    int line = 0;

    struct vec args;
    vec_init(&args);

    for (int i=0; i<count; i++)
    {
        MOKA arg = moka_pop(self);
        vec_push(&args, (void*) arg);
    }

    for (int i=0; i<count; i++)
    {
        MOKA arg = (MOKA) args.data[count - 1 - i];

        struct value* value = frame->local_values.data[arg];
        line = value->line;

        if (value->type == TY_INT)
        {
            base += i == 0
                ? value->data.integer
                : -value->data.integer;;
        }
        else if (value->type == TY_FLOAT)
        {
            base += i == 0
                ? value->data.real
                : -value->data.real;
        }
    }

    vec_free(&args);

    if (count == 1)
    {
        base *= -1.0f;
    }

    if (is_int)
    {
        return moka_push_int(self, (int) base, line);
    }

    return moka_push_float(self, base, line);
}

MOKA moka_mul(struct moka* self, int count)
{
    assert(self);
    struct frame* frame = moka_frame(self);

    float base = 1.0f;
    bool is_int = true;
    int line = 0;

    for (int i=0; i<count; i++)
    {
        MOKA arg = moka_pop(self);

        struct value* value = frame->local_values.data[arg];
        line = value->line;

        if (value->type == TY_INT)
        {
            base *= value->data.integer;
        }
        else if (value->type == TY_FLOAT)
        {
            base *= value->data.real;
            is_int = false;
        }
    }

    if (is_int)
    {
        return moka_push_int(self, (int) base, line);
    }

    return moka_push_float(self, base, line);
}

MOKA moka_div(struct moka* self, int count)
{
    assert(self);
    struct frame* frame = moka_frame(self);

    float base = 1.0f;
    bool is_int = true;
    int line = 0;

    struct vec args;
    vec_init(&args);

    for (int i=0; i<count; i++)
    {
        MOKA arg = moka_pop(self);
        vec_push(&args, (void*) arg);
    }

    for (int i=0; i<count; i++)
    {
        MOKA arg = (MOKA) args.data[count - 1 - i];

        struct value* value = frame->local_values.data[arg];
        line = value->line;

        if (value->type == TY_INT)
        {
            base *= i == 0
                ? value->data.integer
                : 1.0f/value->data.integer;;
        }
        else if (value->type == TY_FLOAT)
        {
            base *= i == 0
                ? value->data.real
                : 1.0f/value->data.real;
            is_int = false;
        }
    }

    vec_free(&args);

    if (count == 1)
    {
        base = 1.0f/base;
    }

    if (is_int)
    {
        return moka_push_int(self, (int) base, line);
    }

    return moka_push_float(self, base, line);
}

MOKA moka_mod(struct moka* self)
{
    struct frame* frame = moka_frame(self);
    struct value* rhs = frame->local_values.data[moka_pop(self)];
    struct value* lhs = frame->local_values.data[moka_pop(self)];

    if (lhs->type == TY_FLOAT || rhs->type == TY_FLOAT)
    {
        return moka_push_float(self,
                             fmod(lhs->data.real, rhs->data.real),
                             lhs->line);
    }

    return moka_push_int(self,
                           fmod(lhs->data.integer, rhs->data.integer),
                           lhs->line);
}

MOKA moka_pow(struct moka* self)
{
    struct frame* frame = moka_frame(self);
    struct value* rhs = frame->local_values.data[moka_pop(self)];
    struct value* lhs = frame->local_values.data[moka_pop(self)];

    if (lhs->type == TY_FLOAT || rhs->type == TY_FLOAT)
    {
        return moka_push_float(self,
                             powf(lhs->data.real, rhs->data.real),
                             lhs->line);
    }

    return moka_push_int(self,
                           pow(lhs->data.integer, rhs->data.integer),
                           lhs->line);
}

bool moka_is(struct moka* self, MOKA value, TypeKind type)
{
    return moka_type_of(self, value) == type;
}

TypeKind moka_type_of(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value const* val = frame->local_values.data[value];
    return val->type;
}

void moka_dump(struct moka* self, MOKA value)
{
    if (moka_is(self, value, TY_REF))
    {
        size_t ref = moka_get_ref(self, value);
        struct value* val = self->global_values.data[ref];

        if (val->type == TY_ARRAY)
        {
            printf("[");
            for (size_t i=0; i<val->data.array->values.size; i++)
            {
                if (i > 0) { printf(" "); }
                MOKA v = (MOKA) val->data.array->values.data[i];
                moka_dump(self, v);
            }

            printf("]");
        }
        else
        {
            char buffer[MK_STRLEN];
            value_str(val, buffer, MK_STRLEN, self);

            printf("%s", buffer);
        }
        return;
    }

    if (moka_is(self, value, TY_INT))
    {
        printf("%d", moka_get_int(self, value));
        return;
    }

    if (moka_is(self, value, TY_FLOAT))
    {
        printf("%f", moka_get_float(self, value));
        return;
    }

    if (moka_is(self, value, TY_BOOL))
    {
        printf("%s", moka_get_bool(self, value) ? "true" : "false");
        return;
    }

    if (moka_is(self, value, TY_STRING))
    {
        printf("%s", moka_get_string(self, value));
        return;
    }

    if (moka_is(self, value, TY_SYMBOL))
    {
        printf("%s", moka_get_symbol(self, value));
        return;
    }

    fprintf(stderr, "cannot dump value of type <%s>\n",
        TypeKindStr[moka_type_of(self, value)]
    );

    abort();
}

MOKA moka_make_array(struct moka* self, int elements_count)
{
    struct value* value = malloc(sizeof(struct value));
    struct vec elements;
    vec_init(&elements);
    int line = 0;
    struct frame* frame = moka_frame(self);

    for (int i=0; i<elements_count; i++)
    {
        MOKA val = moka_pop(self);
        line = ((struct value*) frame->local_values.data[val])->line;
        vec_push(&elements, (void*) val);
    }

    struct vec reverse;
    vec_init(&reverse);

    for (size_t i=0; i<elements.size; i++)
    {
        size_t k = elements.size - 1 - i;
        vec_push(&reverse, elements.data[k]);
    }

    value_init_array(value, &reverse, line);

    vec_push(&self->global_values, value);
    moka_push_ref(self, self->global_values.size - 1, line);

    vec_free(&elements);
    vec_free(&reverse);
    return 0;
}

MOKA moka_call(struct moka* self, int arg_count)
{
    MOKA fun = moka_pop(self);
    struct vec args;
    vec_init(&args);
    int line = 0;

    for (ssize_t i=0; i<arg_count; i++)
    {
        MOKA arg = moka_pop(self);
        line = moka_line(self, arg);
        vec_push(&args, (void*) arg);
    }

    struct value* val = self->global_values.data[
        moka_get_ref(self, fun)
    ];

    assert(val->type == TY_NATIVE);
    struct native* native = val->data.native;

    if (native->arity > 0 && arg_count != native->arity)
    {
        status_push(self->status,
                    STATUS_ERROR,
                    line,
                    "<%d> arguments expected, got <%d>",
                    native->arity,
                    arg_count);
        vec_free(&args);
        return moka_push_bool(self, false, line);
    }

    (native->fun)(self, &args);

    vec_free(&args);
    return moka_top(self);
}

MOKA moka_push(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    vec_push(&frame->stack, (void*) value);
    return value;
}

MOKA moka_push_int(struct moka* self, int value, int line)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = malloc(sizeof(struct value));
    value_init_int(val, value, line);
    vec_push(&frame->local_values, val);
    size_t addr = frame->local_values.size - 1;
    vec_push(&frame->stack, (void*) addr);
    return addr;
}

int moka_get_int(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = frame->local_values.data[value];
    assert(val->type == TY_INT);
    return val->data.integer;
}

MOKA moka_push_float(struct moka* self, float value, int line)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = malloc(sizeof(struct value));
    value_init_float(val, value, line);
    vec_push(&frame->local_values, val);
    size_t addr = frame->local_values.size - 1;
    vec_push(&frame->stack, (void*) addr);
    return addr;
}

float moka_get_float(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = frame->local_values.data[value];
    assert(val->type == TY_FLOAT);
    return val->data.real;
}

MOKA moka_push_bool(struct moka* self, bool value, int line)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = malloc(sizeof(struct value));
    value_init_bool(val, value, line);
    vec_push(&frame->local_values, val);
    size_t addr = frame->local_values.size - 1;
    vec_push(&frame->stack, (void*) addr);
    return addr;
}

bool moka_get_bool(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = frame->local_values.data[value];
    assert(val->type == TY_BOOL);
    return val->data.boolean;
}

MOKA moka_push_string(struct moka* self, char const* value, int line)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = malloc(sizeof(struct value));
    value_init_string(val, value, line);
    vec_push(&frame->local_values, val);
    size_t addr = frame->local_values.size - 1;
    vec_push(&frame->stack, (void*) addr);
    return addr;
}

char* moka_get_string(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = frame->local_values.data[value];
    assert(val->type == TY_STRING);
    return val->data.str;
}

MOKA moka_push_symbol(struct moka* self, char const* value, int line)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = malloc(sizeof(struct value));
    value_init_symbol(val, value, line);
    vec_push(&frame->local_values, val);
    size_t addr = frame->local_values.size - 1;
    vec_push(&frame->stack, (void*) addr);
    return addr;
}

char* moka_get_symbol(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = frame->local_values.data[value];
    assert(val->type == TY_SYMBOL);
    return val->data.sym;
}

MOKA moka_push_ref(struct moka* self, size_t value, int line)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = malloc(sizeof(struct value));
    value_init_ref(val, value, line);
    vec_push(&frame->local_values, val);
    size_t addr = frame->local_values.size - 1;
    vec_push(&frame->stack, (void*) addr);
    return addr;
}

size_t moka_get_ref(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = frame->local_values.data[value];

    assert(val->type == TY_REF);
    return val->data.ref;
}

MOKA moka_push_native(struct moka* self,
                      native_fun_t value,
                      int arity,
                      int line)
{
    assert(self);
    assert(value);

    struct native* native = malloc(sizeof(struct native));
    native_init(native, value, arity);

    struct value* val = malloc(sizeof(struct value));
    value_init_native(val, native, line);

    vec_push(&self->global_values, val);
    size_t addr = self->global_values.size - 1;

    return moka_push_ref(self, addr, line);
}

native_fun_t moka_get_native(struct moka* self, MOKA value)
{
    assert(self);

    size_t addr = moka_get_ref(self, value);
    struct value const* val = self->global_values.data[addr];
    struct native const* native = val->data.native;
    return native->fun;
}

MOKA moka_eval_lazy(struct moka* self, MOKA lazy_value)
{
    assert(self);

    if (!moka_is(self, lazy_value, TY_LAZY))
    {
        return lazy_value;
    }

    struct node* node = moka_get_lazy(self, lazy_value);

    struct compiler compiler;
    compiler_init(&compiler, self->status);

    struct prog prog;
    prog_init(&prog);

    compiler_compile(
        &compiler,
        node,
        &prog,
        self);

    if (!status_is_ok(self->status))
    {
        status_dump(self->status);
        moka_push_int(self, 0, 0);
        goto free_prog;
    }

    struct exec exec;
    exec_init(&exec);

    exec_prog(&exec, self, &prog);

    exec_free(&exec);
free_prog:
    prog_free(&prog);
    compiler_free(&compiler);

    return moka_pop(self);
}

MOKA moka_push_lazy(struct moka* self, struct node* value, int line)
{
    assert(self);
    assert(value);

    struct value* val = malloc(sizeof(struct value));
    value_init_lazy(val, value, line);

    struct frame* frame = moka_frame(self);
    vec_push(&frame->local_values, val);
    size_t addr = frame->local_values.size - 1;
    vec_push(&frame->stack, (void*) addr);
    return addr;
}

struct node* moka_get_lazy(struct moka* self, MOKA value)
{
    assert(self);
    struct frame* frame = moka_frame(self);
    struct value* val = frame->local_values.data[value];
    assert(val->type == TY_LAZY);
    return val->data.lazy;
}