lval* builtin_var(lenv* e, lval* a, char* func)
{
LASSERT_TYPE(func, a, 0, LVAL_QEXPR);
lval* syms = a->cell[0];
for (int i = 0; i < syms->count; i++)
LASSERT(a, syms->cell[i]->type == LVAL_SYM,
"Function '%s' cannot define a non-symbol. Got %s, Expected %s.",
func, ltype_name(syms->cell[i]->type), ltype_name(LVAL_SYM));
LASSERT(a, syms->count == a->count - 1,
"Function '%s' passed too many arguments for symbols. Got %i, Expected %i.",
func, syms->count, a->count - 1);
for (int i = 0; i < syms->count; i++)
{
if (strcmp(func, "def") == 0)
lenv_def(e, syms->cell[i], a->cell[i+1]);
if (strcmp(func, "=") == 0)
lenv_put(e, syms->cell[i], a->cell[i+1]);
}
lval_del(a);
return lval_sexpr();
}
lval *builtin_var(lenv *e, lval *a, char *func)
{
LASSERT_TYPE("def", a, 0, LVAL_QEXPR);
lval *syms = a->cell[0];
for (int i = 0; i < syms->count; i++)
{
LASSERT(a, (syms->cell[i]->type == LVAL_SYM),
"Function 'def' cannot define non-symbol"
"\n got %s expected %s",
ltype_name(syms->cell[i]->type), ltype_name(LVAL_SYM));
}
LASSERT(a, (syms->count == a->count-1),
"Function 'def' passed too many arguments for symbols"
"\n got %i expected %i",
syms->count, a->count-1);
for (int i = 0; i < syms->count; i++)
{
if (strcmp(func, "def") == 0)
{
lenv_def(e, syms->cell[i], a->cell[i + 1]);
}
if (strcmp(func, "=") == 0)
{
lenv_put(e, syms->cell[i], a->cell[i + 1]);
}
}
lval_del(a);
return lval_sexpr();
}
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 *builtin_lambda(lenv *e, lval *a)
{
LASSERT_NUM("\\", a, 2);
LASSERT_TYPE("\\", a, 0, LVAL_QEXPR);
LASSERT_TYPE("\\", a, 1, LVAL_QEXPR);
for (int i = 0; i < a->cell[0]->count; i++)
{
LASSERT(a, (a->cell[0]->cell[i]->type == LVAL_SYM),
"Cannot define non-symbol\n got %s expected %s",
ltype_name(a->cell[0]->cell[i]->type), ltype_name(LVAL_SYM));
}
lval *formals = lval_pop(a, 0);
lval *body = lval_pop(a, 0);
lval_del(a);
return lval_lambda(formals, body);
}
lval* builtin_lambda(lenv* e, lval* a) {
LASSERT_NUM("\\", a, 2);
LASSERT_TYPE("\\", a, 0, LVAL_QEXPR);
LASSERT_TYPE("\\", a, 1, LVAL_QEXPR);
// Check that first q-expr 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 args 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);
}
lval* builtin_lambda(lenv* e, lval* a) {
/* Check 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);
}
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* lval_copy(lval *v) {
lval* x;
gl_log(L_DEBUG, "Copying lval of type: %s", ltype_name(v->type));
switch (v->type) {
case LVAL_FUN:
x = new_lval(v->type, 0);
if (v->builtin) {
x->builtin = v->builtin;
} else {
x->builtin = NULL;
x->env = lenv_copy(v->env);
x->formals = lval_copy(v->formals);
x->body = lval_copy(v->body);
}
break;
case LVAL_NUM:
x = new_lval(v->type, 0);
x->num = v->num;
break;
case LVAL_ERR:
x = new_lval(v->type, strlen(v->err) + 1);
x->err = malloc(strlen(v->err) + 1);
strcpy(x->err, v->err);
break;
case LVAL_SYM:
x = new_lval(v->type, strlen(v->sym) + 1);
x->sym = malloc(strlen(v->sym) + 1);
strcpy(x->sym, v->sym);
break;
case LVAL_STR:
x = new_lval(v->type, strlen(v->str) + 1);
x->str = malloc(strlen(v->str) + 1);
strcpy(x->str, v->str);
break;
case LVAL_SEXPR:
case LVAL_QEXPR:
x = new_lval(v->type, sizeof(lval*) * v->count);
x->count = v->count;
x->cell = malloc(sizeof(lval*) * x->count);
for (int i = 0; i < x->count; i++) {
x->cell[i] = lval_copy(v->cell[i]);
}
break;
}
x->type = v->type;
return x;
}