lval* builtin_len(lenv* e, lval* a) {
LASSERT_NUM("len", a, 1);
LASSERT_TYPE("len", a, 0, LVAL_QEXPR);
long x = a->cell[0]->count;
lval_del(a);
return lval_num(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);
}
lval* builtin_cmp(lenv* e, lval* a, char* op) {
LASSERT_NUM(op, a, 2);
int r;
if (strcmp(op, "==") == 0) { r = lval_eq(a->cell[0], a->cell[1]); }
if (strcmp(op, "!=") == 0) { r = !lval_eq(a->cell[0], a->cell[1]); }
lval_del(a);
return lval_num(r);
}
lval* builtin_not(lenv* e, lval* a) {
LASSERT_NUM("!", a, 1);
LASSERT_TYPE("!", a, 0, LVAL_NUM);
int r = !a->cell[0]->num;
lval_del(a);
return lval_num(r);
}
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;
}
//Appends element to beginning of list
lval* builtin_cons(lenv* e, lval* a) {
LASSERT_NUM("cons", a, 2);
LASSERT_TYPE("cons", a, 1, LVAL_QEXPR);
lval* x = lval_qexpr();
x = lval_add(x, lval_pop(a, 0));
x = lval_join(x, lval_pop(a, 0));
lval_del(a);
return x;
}
lval* builtin_error(lenv* e, lval* a) {
LASSERT_NUM("error", a, 1);
LASSERT_TYPE("error", a, 0, LVAL_STR);
//Build error from first arg
lval* err = lval_err(a->cell[0]->str);
//clean up, return
lval_del(a);
return err;
}
lval* builtin_logic(lenv* e, lval* a, char* op) {
LASSERT_NUM(op, a, 2);
LASSERT_TYPE(op, a, 0, LVAL_NUM);
LASSERT_TYPE(op, a, 1, LVAL_NUM);
int r;
if (strcmp(op, "&&") == 0) { r = a->cell[0]->num && a->cell[1]->num; }
if (strcmp(op, "||") == 0) { r = a->cell[0]->num || a->cell[1]->num; }
lval_del(a);
return lval_num(r);
}
lval* builtin_ord(lenv* e, lval* a, char* op) {
LASSERT_NUM(op, a, 2);
LASSERT_TYPE(op, a, 0, LVAL_NUM);
LASSERT_TYPE(op, a, 1, LVAL_NUM);
int r;
if (strcmp(op, ">") == 0) { r = a->cell[0]->num > a->cell[1]->num; }
if (strcmp(op, "<") == 0) { r = a->cell[0]->num < a->cell[1]->num; }
if (strcmp(op, ">=") == 0) { r = a->cell[0]->num >= a->cell[1]->num; }
if (strcmp(op, "<=") == 0) { r = a->cell[0]->num <= a->cell[1]->num; }
lval_del(a);
return lval_num(r);
}
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_if(lenv* e, lval* a) {
LASSERT_NUM("if", a, 3);
LASSERT_TYPE("if", a, 0, LVAL_NUM);
LASSERT_TYPE("if", a, 1, LVAL_QEXPR);
LASSERT_TYPE("if", a, 2, LVAL_QEXPR);
//Make both expressions evaluatable
lval* x;
a->cell[1]->type = LVAL_SEXPR;
a->cell[2]->type = LVAL_SEXPR;
if (a->cell[0]->num) {
x = lval_eval(e, lval_pop(a, 1));
} else {
x = lval_eval(e, lval_pop(a, 2));
}
lval_del(a);
return x;
}
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* builtin_load(lenv* e, lval* a) {
LASSERT_NUM("load", a, 1);
LASSERT_TYPE("load", a, 0, LVAL_STR);
//Parse file given by string as filename
mpc_result_t r;
if (mpc_parse_contents(a->cell[0]->str, blisp, &r)) {
//Read Contents
lval* expr = lval_read(r.output);
mpc_ast_delete(r.output);
//Evaluate expressions on stack
while (expr->count) {
lval* x = lval_eval(e, lval_pop(expr, 0));
if (x->type == LVAL_ERR) {
lval_println(x);
}
lval_del(x);
}
//Delete expression and args
lval_del(expr);
lval_del(a);
//Return empty list
return lval_sexpr();
} else {
//Get error message as string and return as lval_err
char* err_msg = mpc_err_string(r.error);
mpc_err_delete(r.error);
lval* err = lval_err("Could not load Library %s", err_msg);
free(err_msg);
lval_del(a);
//Cleanup and return error
return err;
}
}