lval* lval_eval_sexpr(lval* v) {
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type != LVAL_ERR) {
v->cell[i] = lval_eval(v->cell[i]);
} else {
return lval_take(v, i);
}
}
if (v->count == 0) {
return v;
}
if (v->count == 1) {
return lval_take(v, 0);
}
lval* f = lval_pop(v, 0);
if (f->type != LVAL_SYM) {
lval_free(f);
lval_free(v);
return lval_err("S-Expression doesn't start with symbol!");
}
lval* result = builtin_op(v, f->sym);
lval_free(f);
return result;
}
struct lval* lval_builtin_last(struct lenv* e, struct lval* v) {
LNUMARGS(v, 1, "last");
LNONEMPTY(v, 0, "last");
struct lval* l = lval_take(v, 0);
return lval_take(l, l->count - 1);
}
lval* lval_eval_sexpr(lval* v) {
// eval all children to lval
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(v->cell[i]);
}
// check lvals for errors
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
}
if (v->count == 0) { return v; }
if (v->count == 1) { return lval_take(v, 0); }
// ensure 1st element is a symbol
lval* f = lval_pop(v, 0);
if (f->type != LVAL_SYM) {
lval_del(f); lval_del(v);
return lval_err("S-expression does not start with symbol");
}
lval* result = builtin(v, f->sym);
lval_del(f);
return result;
}
lval* lval_eval_sexpr(lval* v) {
/* Evaluate Children */
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(v->cell[i]);
}
/* Error Checking */
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 Symbol */
lval* f = lval_pop(v, 0);
if (f->type != LVAL_SYM) {
lval_del(f); lval_del(v);
return lval_err("S-expression Does not start with symbol.");
}
/* Call builtin with operator */
lval* result = builtin_op(v, f->sym);
lval_del(f);
return result;
}
lval* lval_eval_sexpr(lenv* e, lval* v) {
_lval_eval_children(e, v);
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == LVAL_ERR) {
return lval_take(v, i);
}
}
if (v->count == 0) { return v; }
if (v->count == 1) { return lval_take(v, 0); }
lval* f = lval_pop(v, 0);
if (f->type != LVAL_FUN) {
lval* err = lval_err(
"S-Expression starts with incorrect type. "
"Got %s, Expected %s.",
ltype_name(f->type), ltype_name(LVAL_FUN));
lval_del(f);
lval_del(v);
return err;
}
lval* result = lval_call(e, f, v);
lval_del(f);
return result;
}
lval* lval_eval_sexpr(lval* v){
/* Children, recursion */
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(v->cell[i]);
if (v->cell[i]->type == LVAL_ERR) {
return lval_take(v, i);
}
}
/* Empty expresion */
if (v->count == 0) {
return v;
}
if (v->count == 1) {
return lval_take(v, 0);
}
/* Ensure First Element is Symbol */
lval* f = lval_pop(v, 0);
if (f->type != LVAL_SYM) {
lval_del(f);
lval_del(v);
return lval_err("Not start with symbol!");
}
/* Call builtin with operator */
lval* result = builtin(v, f->sym);
lval_del(f);
return result;
}
struct lval* lval_builtin_def(struct lenv* e, struct lval* v) {
LTYPE(v, LVAL_QEXP, 0, "def");
struct lval* syms = v->cell[0];
for (int i = 0; i < syms->count; i++) {
LASSERT(v, syms->cell[i]->type == LVAL_SYM,
"'def' expects variable %i to be symbol", i);
}
LASSERT(v, syms->count == (v->count - 1),
"'def' expects same variable & value count. "
"Got %i variables and %i values.",
syms->count, v->count -1);
for (int i = 0; i < syms->count; i++) {
char* sym = syms->cell[i]->sym;
struct lval* x = lenv_get(e, sym);
if (x->type == LVAL_FUN && x->fun_type == LVAL_FUN_BUILTIN) {
struct lval* err = lval_err(
"Cannot redefine builtin function '%s'", sym);
lval_del(v);
return err;
}
lenv_def(e, sym, v->cell[i + 1]);
}
return lval_take(v, 0);
}
struct lval* lval_eval_sexp(struct lenv* e, struct lval* v) {
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(e, v->cell[i]);
}
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == LVAL_ERR) {
return lval_take(v, i);
}
}
if (v->count == 0) return v;
struct lval* f = lval_pop(v, 0);
if (f->type != LVAL_FUN) {
struct lval* err = lval_err(
"Expected sexp to begin with %s, got %s",
lval_type_name(LVAL_FUN), lval_type_name(f->type));
lval_del(f);
lval_del(v);
return err;
}
struct lval* result = lval_eval_call(e, f, v);
lval_del(f);
return result;
}
lval_t* builtin_tail(lval_t* a){
LASSERT(a, a->count==1, "Function 'tail' passed too many arguments!");
LASSERT(a, a->cell[0]->count != 0, "Function 'tail' passed {}");
lval_t* v = lval_take(a, 0);
lval_free(lval_pop(v, 0));
return v;
}
lval *lval_eval_sexpr(lval *v) {
for (int i = 0; i < v->count; i++) {
v->cell[i] = lval_eval(v->cell[i]);
}
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type == LVAL_ERR) {
lval *err = lval_err(v->cell[i]->err);
lval_del(v);
return err;
}
}
if (v->count == 0) {
return v;
}
if (v->count == 1) {
return lval_take(v, 0);
}
lval *f = lval_pop(v, 0);
if (f->type != LVAL_SYM) {
lval_del(f);
lval_del(v);
return lval_err("S-expression does not start with a symbol");
}
lval *result = builtin(v, f->sym);
lval_del(f);
return result;
}
struct lval* lval_builtin_tail(struct lenv* e, struct lval* v) {
LNUMARGS(v, 1, "tail");
LNONEMPTY(v, 0, "tail");
struct lval* x = lval_take(v, 0);
lval_del(lval_pop(x, 0));
return x;
}
struct lval* lval_builtin_init(struct lenv* e, struct lval* v) {
LNUMARGS(v, 1, "init");
LNONEMPTY(v, 0, "init");
struct lval* x = lval_take(v, 0);
lval_del(lval_pop(x, x->count - 1));
return x;
}
lval* builtin_eval(lval* a) {
LASSERT(a, (a->count == 1), "Function 'eval' passed too many arguments.");
LASSERT(a, (a->cell[0]->type == LVAL_QEXPR), "Function 'eval' passed incorrect type.");
lval* x = lval_take(a, 0);
x->type = LVAL_SEXPR;
return lval_eval(x);
}
//Evaluate a list as an expression
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);
}
struct lval* lval_builtin_not(struct lenv* e, struct lval* v) {
LNUMARGS(v, 1, "not");
LTYPE(v, LVAL_BOOL, 0, "not");
struct lval* x = lval_take(v, 0);
x->flag = !x->flag;
return x;
}
struct lval* lval_builtin_eval(struct lenv* e, struct lval* v) {
LNUMARGS(v, 1, "eval");
LTYPE(v, LVAL_QEXP, 0, "eval");
struct lval* x = lval_take(v, 0);
x->type = LVAL_SEXP;
return lval_eval(e, x);
}
lval* builtin_head(lval* a) {
LASSERT(a, (a->count == 1), "Function 'head' passed too many arguments!");
LASSERT(a, (a->cell[0]->type == LVAL_QEXPR), "Function 'head' passed incorrect type!");
LASSERT(a, (a->cell[0]->count != 0), "Function 'head' passed {}");
lval* v = lval_take(a, 0);
while (v->count > 1) { lval_del(lval_pop(v, 1)); }
return v;
}
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);
lval* x = lval_take(a, 0);
lval_pop(x, x->count-1);
return x;
}
//Return all but the first element in a list
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_head(lenv* e, lval* a) {
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 > 1) { lval_del(lval_pop(v, 1)); }
return v;
}
lval_t* builtin_head(lval_t* a){
LASSERT(a, a->count==1, "Function 'head' passed too many arguments!");
LASSERT(a, a->cell[0]->count != 0, "Function head passed {}");
lval_t* v = lval_take(a, 0);
while(v->count > 1){
lval_free(lval_pop(v, 1));
}
return v;
}
lval* builtin_tail(lval* a) {
LASSERT(a, (a->count == 1), "Function 'tail' passed too many arguments!");
LASSERT(a, (a->cell[0]->type == LVAL_QEXPR), "Function 'tail' passed incorrect type!");
LASSERT(a, (a->cell[0]->count != 0), "Function 'tail' passed {}!");
lval* v = lval_take(a, 0);
lval_del(lval_pop(v, 0));
return v;
}
lval* builtin_eval(lval* a) {
LASSERT(a, a->count == 1,
"eval takes one arg");
LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
"eval takes qexpr");
lval* x = lval_take(a, 0);
x->type = LVAL_SEXPR;
return lval_eval(x);
}
lval* builtin_tail(lenv* env, lval* node) {
UNUSED(env);
LASSERT_ARG_COUNT("tail", node, 1);
LASSERT_ARG_TYPE("tail", node, 0, LVAL_QEXPR);
LASSERT_ARG_NOT_EMPTY_LIST("tail", node, 0);
lval* qexpr = lval_take(node, 0);
lval_del(lval_pop(qexpr, 0));
return qexpr;
}
lval* builtin_tail(lval* a) {
LASSERT(a, a->count == 1,
"tail takes one arg");
LASSERT(a, a->cell[0]->type == LVAL_QEXPR,
"tail takes qexpr");
LASSERT(a, a->cell[0]->count != 0,
"tail passed empty qexpr");
lval* v = lval_take(a, 0);
while (v->count > 1) { lval_del(lval_pop(v, 0)); }
return v;
}
struct lval* lval_builtin_if(struct lenv* e, struct lval* v) {
LNUMARGS(v, 3, "if");
LTYPE(v, LVAL_BOOL, 0, "if");
LTYPE(v, LVAL_QEXP, 1, "if");
LTYPE(v, LVAL_QEXP, 2, "if");
int result = v->cell[0]->flag;
struct lval* x = lval_sexp();
lval_add(x, lval_take(v, result ? 1 : 2));
return lval_builtin_eval(e, x);
}
lval *lval_eval_sexpr(lenv *e, lval *v)
{
// eval children
for (int i = 0; i < v->count; i++)
{
v->cell[i] = lval_eval(e, v->cell[i]);
}
// error checking
for (int i = 0; i < v->count; i++)
{
if (v->cell[i]->type == LVAL_ERR) { return lval_take(v, i); }
}
// empty expr
if (v->count == 0) { return v; }
// single expr
if (v->count == 1) { return lval_take(v, 0); }
// make sure first elem is symbol
lval *f = lval_pop(v, 0);
if (f->type != LVAL_FUN)
{
lval* err = lval_err(
"S-Expression starts with incorrect type"
"\n got %s expected %s",
ltype_name(f->type), ltype_name(LVAL_FUN));
lval_del(f); lval_del(v);
return err;
}
// call builtin with operator
lval *result = lval_call(e, f, v);
lval_del(f);
return result;
}
lval* builtin_head(lenv* env, lval* node) {
UNUSED(env);
LASSERT_ARG_COUNT("head", node, 1);
LASSERT_ARG_TYPE("head", node, 0, LVAL_QEXPR);
LASSERT_ARG_NOT_EMPTY_LIST("head", node, 0);
lval* qexpr = lval_take(node, 0);
// Delete all elements that are not head and return
while (qexpr->count > 1) {
lval_del(lval_pop(qexpr, 1));
}
return qexpr;
}
static lval * builtin_cons(lval *a) {
LASSERT(a, a->count == 2,
"Function 'cons' passed too many arguments!");
LASSERT(a, a->cell[0]->type == LVAL_NUM,
"Function 'cons' passed incorrect type!");
LASSERT(a, a->cell[1]->type == LVAL_QEXPR,
"Function 'cons' passed incorrect type!");
lval *n = lval_pop(a, 0);
lval *v = lval_take(a, 0);
v->count++;
v->cell = realloc(v->cell, sizeof(lval *) * v->count);
memmove(&v->cell[1], &v->cell[0], sizeof(lval *) * (v->count - 1));
v->cell[0] = n;
return v;
}
struct lval* lval_builtin_cons(struct lenv* e, struct lval* v) {
LNUMARGS(v, 2, "cons");
LTYPE(v, LVAL_QEXP, 1, "cons");
// New q-exp with first arg
struct lval* x = lval_qexp();
lval_add(x, lval_pop(v, 0));
// Old q-exp from second arg
struct lval* q = lval_take(v, 0);
while (q->count) {
lval_add(x, lval_pop(q, 0));
}
lval_del(q);
return lval_eval(e, x);
}
