lispy/lval/environment.c

#include "environment.h"
#include <stdlib.h>
#include "error.h"
#include "expressions.h"
#include "operations.h"

lenv* lenv_new(void) {
    lenv* e = (lenv*) malloc(sizeof(lenv));
    e->count = 0;
    e->syms = NULL;
    e->vals = NULL;
    return e;
}

void lenv_del(lenv* e) {
    for (int i = 0; i < e->count; i++) {
        free(e->syms[i]);
        lval_del(e->vals[i]);
    }
    free(e->syms);
    free(e->vals);
    free(e);
}

lenv* lenv_copy(lenv* e) {
    lenv* n = malloc(sizeof(lenv));
    n->count = e->count;
    n->syms = malloc(sizeof(char*) * n->count);
    n->vals = malloc(sizeof(lval*) * n->count);
    for (int i = 0; i < e->count; i++) {
        n->syms[i] = malloc(strlen(e->syms[i]) + 1);
        strcpy(n->syms[i], e->syms[i]);
        n->vals[i] = lval_copy(e->vals[i]);
    }
    return n;
}

lval* lenv_get(lenv* e, lval* k) {
    // Iterate over all items in environment
    for (int i = 0; i < e->count; i++) {
        // Check if the stored string matches the symbol string
        // If it does, return a copy of hte value
        if (strcmp(e->syms[i], k->sym) == 0) {
            return lval_copy(e->vals[i]);
        }
    }

    // If no symbol found return error
    return lval_err("Unbounded symbol %s", k->sym);
}

void lenv_put(lenv* e, lval* k, lval* v) {
    // Iterate over all items in the environment
    // This is to see if the variables already exist
    for (int i = 0; i < e->count; i++) {
        // If a variable is found, delete the item at that position
        // Then replace it with the data provided by the user
        if (strcmp(e->syms[i], k->sym) == 0) {
            lval_del(e->vals[i]);
            e->vals[i] = lval_copy(v);
            return;
        }
    }

    // If no existing entry is found, allocate space for new entry
    e->count++;
    e->vals = realloc(e->vals, sizeof(lval*) * e->count);
    e->syms = realloc(e->syms, sizeof(char*) * e->count);

    // Copy contents of lval and symbol string
    e->vals[e->count - 1] = lval_copy(v);
    e->syms[e->count - 1] = (char*) malloc(strlen(k->sym) + 1);
    strcpy(e->syms[e->count - 1], k->sym);
}

lval* lval_fun(lbuiltin func) {
    lval* v = malloc(sizeof(lval));
    v->type = LVAL_FUN;
    v->builtin = func;
    return v;
}

void lenv_add_builtin(lenv* e, char* name, lbuiltin func) {
    lval* k = lval_sym(name);
    lval* v = lval_fun(func);
    lenv_put(e, k, v);
    lval_del(k); lval_del(v);
}

void lenv_add_builtins(lenv* e) {
    // List functions
    lenv_add_builtin(e, "list", builtin_list);
    lenv_add_builtin(e, "head", builtin_head);
    lenv_add_builtin(e, "tail", builtin_tail);
    lenv_add_builtin(e, "eval", builtin_eval);
    lenv_add_builtin(e, "join", builtin_join);
    lenv_add_builtin(e, "len", builtin_len);
    lenv_add_builtin(e, "cons", builtin_cons);

    // Mathematical Functions
    lenv_add_builtin(e, "+", builtin_add);
    lenv_add_builtin(e, "-", builtin_sub);
    lenv_add_builtin(e, "*", builtin_mul);
    lenv_add_builtin(e, "/", builtin_div);
    lenv_add_builtin(e, "^", builtin_pow);
    lenv_add_builtin(e, "%", builtin_mod);
    lenv_add_builtin(e, "min", builtin_min);
    lenv_add_builtin(e, "max", builtin_max);
    
    lenv_add_builtin(e, "def", builtin_def);
    lenv_add_builtin(e, "ls", builtin_ls);
    lenv_add_builtin(e, "\\", builtin_lambda);
}

lval* builtin_def(lenv* e, lval* a) {
    LASSERT_TYPE("def", a, 0, LVAL_QEXPR)

    // First argument is the symbol list
    lval* syms = a->cell[0];

    // Ensure all elements of the first list are symbols
    for (int i = 0; i < syms->count; i++) {
        LASSERT(a, syms->cell[i]->type == LVAL_SYM,
            "Function 'def' cannot define non-symbol")
    }

    // Check correct number of symbols and values
    LASSERT(a, syms->count == a->count - 1,
        "Function 'def' cannot define incorrect number of values to symbols. Left side %i, right side %i", syms->count, a->count - 1)

    // Assign copies of values to symbols
    for (int i = 0; i < syms->count; i++) {
        lenv_put(e, syms->cell[i], a->cell[i + 1]);
    }

    lval_del(a);
    return lval_sexpr();
}

lval* builtin_ls(lenv* e, lval* a) {
    LASSERT_NUM("ls", a, 0)

    lval* x = lval_qexpr();
    for (int i = 0; i < e->count; i++) {
        lval_add(x, lval_sym(e->syms[i]));
    }

    lval_del(a);
    return x;
}

lval* lval_lambda(lval* formals, lval* body) {
    lval* v = malloc(sizeof(lval));
    v->type = LVAL_FUN;

    // Set builtin to null
    v->builtin = NULL;

    // Build new environment
    v->env = lenv_new();

    // Set formals and body
    v->formals = formals;
    v->body = body;
    return v;
}

lval* builtin_lambda(lenv* e, lval* a) {
    // Check for two arguments each of which are Q-Expressions
    LASSERT_NUM("\\", a, 2)
    LASSERT_TYPE("\\", a, 0, LVAL_QEXPR)
    LASSERT_TYPE("\\", a, 1, LVAL_QEXPR)

    // Check first Q-expression contains only symbols
    for (int i = 0; i < a->cell[0]->count; i++) {
        LASSERT(a, (a->cell[0]->cell[i]->type == LVAL_SYM),
            "Cannot define non-symbol. Got %s, expected %s.",
            ltype_name(a->cell[0]->cell[i]->type), ltype_name(LVAL_SYM))
    }

    // Pop first two arguments and pass them to lval_lambda
    lval* formals = lval_pop(a, 0);
    lval* body = lval_pop(a, 0);
    lval_del(a);

    return lval_lambda(formals, body);
}