lispy/lval/expressions.c

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

#include "expressions.h"
#include "numbers.h"
#include "operations.h"
#include "error.h"

// Think about where to put these declarations later
lval* builtin(lval* a, char* func);
lval* builtin_op(lval* v, char* op);

lval* lval_sexpr(void) {
	lval* v = (lval *) malloc(sizeof(lval));
	v->type = LVAL_SEXPR;
	v->count = 0;
	v->cell = NULL;
	return v;
}
lval* lval_qexpr(void) {
	lval* v = (lval *) malloc(sizeof(lval));
	v->type = LVAL_QEXPR;
	v->count = 0;
	v->cell = NULL;
	return v;
}

lval* lval_add(lval* v, lval* x) {
	v->count++;
	v->cell = (lval **) realloc(v->cell, sizeof(lval*) * v->count);
	v->cell[v->count - 1] = x;
	return v;
}

lval* lval_pop(lval* v, int i) {
	// Find the item at i
	lval* x = v->cell[i];

	// Shift the memory after the item i over the top
	memmove(&v->cell[i], &v->cell[i + 1], sizeof(lval*) * (v->count - i - 1));

	// Decrease the count of items in the list
	v->count--;

	// Reallocate the memory used
	v->cell = (lval **) realloc(v->cell, sizeof(lval*) * v->count);
	return x;
}

lval* lval_take(lval* v, int i) {
	lval* x = lval_pop(v, i);
	lval_del(v);
	return x;
}

lval* lval_eval_sexpr(lenv* e, lval* v) {
	// No argument functions
	if (v->count == 1 && v->cell[0]->type == LVAL_SYM) {
		if (strcmp(v->cell[0]->sym, "exit") == 0) { return v; }
		lval* x = lenv_get(e, v->cell[0]);
		if (x->type == LVAL_FUN) {
			lval_del(x);
			if (strcmp(v->cell[0]->sym, "ls") == 0) {
				lval_del(v);
				return builtin_ls(e, lval_sexpr());
			}
			return v;
		}
		if (x->type == LVAL_ERR) { lval_del(v); return x; }
		lval_del(x);
		return v;
	}
	// Evaluate children
	for (int i = 0; i < v->count; i++) {
		v->cell[i] = lval_eval(e, v->cell[i]);
	}

	// Error checking [If there's an error, return it]
	for (int i = 0; i < v->count; i++) {
		if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
	}

	// Empty expression
	if (v->count == 0) { return v; }

	// Single expression
	if (v->count == 1) { return lval_take(v, 0); }

	// Ensure first element is a symbol otherwise
	lval* f = lval_pop(v, 0);
	if (f->type != LVAL_FUN) {
		lval_del(f); lval_del(v);
		return lval_err("S-expression does not start with function");
	}

	// If so call the function and return result
	lval* result = f->builtin(e, v);
	lval_del(f);
	return result;
}


lval* builtin_headn(lenv* e, lval* a, int n) {
	LASSERT_NUM("head", a, 1)
	LASSERT_TYPE("head", a, 0, LVAL_QEXPR)
	LASSERT_NOT_EMPTY("head", a, 0)

	lval* v = lval_take(a, 0);
	while (v->count > n) { lval_del(lval_pop(v, v->count - 1)); }
	return v;
}

lval* builtin_head(lenv* e, lval* a) {
	return builtin_headn(e, a, 1);
}

lval* builtin_init(lenv* e, lval* a) {
	LASSERT_NUM("init", a, 1)
	LASSERT_TYPE("init", a, 0, LVAL_QEXPR)
	LASSERT_NOT_EMPTY("init", a, 0)
	return builtin_headn(e, a, a->cell[0]->count - 1);
}


lval* builtin_tail(lenv* e, lval* a) {
	LASSERT_NUM("tail", a, 1)
	LASSERT_TYPE("tail", a, 0, LVAL_QEXPR)
	LASSERT_NOT_EMPTY("tail", a, 0)

	lval* v = lval_take(a, 0);
	lval_del(lval_pop(v, 0));
	return v;
}

lval* builtin_list(lenv* e, lval* a) {
	a->type = LVAL_QEXPR;
	return a;
}

lval* builtin_eval(lenv* e, lval* a) {
	LASSERT_NUM("eval", a, 1)
	LASSERT_TYPE("eval", a, 0, LVAL_QEXPR)

	lval* x = lval_take(a, 0);
	x->type = LVAL_SEXPR;
	return lval_eval(e, x);
}

lval* lval_join(lenv* e, lval* x, lval* y) {
	// For each cell in 'y' add it to 'x'
	while (y->count) {
		x = lval_add(x, lval_pop(y, 0));
	}

	// Delete the empty y and return x
	lval_del(y);
	return x;
}

lval* builtin_join(lenv* e, lval* a) {
	for (int i = 0 ; i < a->count; i++) {
		LASSERT_TYPE("join", a, i, LVAL_QEXPR)
	}

	lval* x = lval_pop(a, 0);
	
	while (a->count) {
		x = lval_join(e, x, lval_pop(a, 0));
	}

	lval_del(a);
	return x;
}

lval* builtin_len(lenv* e, lval* a) {
	LASSERT_TYPE("len", a, 0, LVAL_QEXPR)
	lval* x = lval_long(a->cell[0]->count);
	
	lval_del(a);
	return x;
}

lval* builtin_cons(lenv* e, lval* a) {
	LASSERT(a, a->cell[0]->type != LVAL_QEXPR, "Function 'cons' passed incorrect type on first argument. Got %s, expected not %s",
		ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR))
	LASSERT_TYPE("cons", a, 1, LVAL_QEXPR)
	LASSERT_NUM("cons", a, 2)
	
	lval* x = lval_qexpr();
	x = lval_add(x, lval_pop(a, 0));
	x = lval_join(e, x, lval_pop(a, 0));

	lval_del(a);

	return x;

}