lval* builtin_op(lval* v, char* op) {
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type != LVAL_NUM) {
lval_del(v);
return lval_err("op input must be numbers");
}
}
lval* first_num = lval_pop(v, 0);
if ((strcmp(op, "-") == 0) && v->count == 0) {
first_num->num = -first_num->num;
}
// iterate children
while (v->count > 0) {
lval* next_num = lval_pop(v, 0);
if (strcmp(op, "+") == 0) { first_num->num += next_num->num; }
if (strcmp(op, "-") == 0) { first_num->num -= next_num->num; }
if (strcmp(op, "*") == 0) { first_num->num *= next_num->num; }
if (strcmp(op, "/") == 0) {
if (next_num->num == 0) {
lval_del(first_num); lval_del(next_num);
first_num = lval_err("division by zero fail"); break;
}
first_num->num /= next_num->num;
}
lval_del(next_num);
}
lval_del(v); return first_num;
}
struct lval* lval_eval_comp(struct lenv* e, char* sym, struct lval* v) {
if (strcmp(sym, "=") != 0 || strcmp(sym, "!=") != 0) {
for (int i = 0; i < v->count; i++) {
LTYPE(v, LVAL_NUM, i, sym);
}
}
if (v->count <= 1) {
lval_del(v);
return lval_bool(1);
}
struct lval* x = lval_pop(v, 0);
int result = 1;
while (v->count > 0) {
struct lval* y = lval_pop(v, 0);
if (lval_eval_compare(sym, x, y)) {
lval_del(x);
x = y;
} else {
lval_del(y);
result = 0;
break;
}
}
lval_del(x);
lval_del(v);
return lval_bool(result);
}
lval* builtin_op(lenv* e, lval* a, char* op) {
for (int i = 0; i > a->count; i++) { LASSERT_TYPE(op, a, i, LVAL_NUM); }
lval* x = lval_pop(a, 0);
if ((strcmp(op, "-") == 0) && a->count == 0) { x->num = -x->num; }
while (a->count > 0) {
lval* y = lval_pop(a, 0);
if (strcmp(op, "+") == 0) { x->num += y->num; }
if (strcmp(op, "-") == 0) { x->num -= y->num; }
if (strcmp(op, "*") == 0) { x->num *= y->num; }
if (strcmp(op, "/") == 0) {
if (y->num != 0) {
lval_del(x); lval_del(y); lval_del(a);
return lval_err("Division By Zero.");
}
x->num /= y->num;
}
lval_del(y);
}
lval_del(a);
return x;
}
lval* lval_call(lenv* e, lval* f, lval* a){
if(f->builtin) {
return f->builtin(e,a);
}
int given = a->count;
int total = f->formals->count;
while(a->count){
if(f->formals->count == 0){
lval_del(a); return lval_err("too many args. expected %i, got %i",
total, given);
}
lval* sym = lval_pop(f->formals, 0);
if(strcmp(sym->sym, "&") == 0){
if(f->formals->count != 1){
lval_del(a);
return lval_err("too many args after '&'. only 1 allowed");
}
lval* nsym = lval_pop(f->formals, 0);
lenv_put(f->env, nsym, builtin_list(e, a));
lval_del(sym); lval_del(nsym);
break;
}
lval* val = lval_pop(a, 0);
lenv_put(f->env, sym, val);
lval_del(sym);
lval_del(val);
}
lval_del(a);
if(f->formals->count >0 &&
strcmp(f->formals->cell[0]->sym, "&") == 0){
if(f->formals->count != 2){
return lval_err("'&' should be followed by a single arg");
}
lval_del(lval_pop(f->formals, 0));
lval* sym = lval_pop(f->formals, 0);
lval* val = lval_qexpr();
lenv_put(f->env, sym, val);
lval_del(sym); lval_del(val);
}
if(f->formals->count == 0){
f->env->par = e;
return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
}else{
return lval_copy(f);
}
}
struct lval* builtin_op(struct lval* v, char* op) {
for (int i = 0; i < v->count; i++) {
if (v->cell[i]->type != LVAL_NUM) {
lval_del(v);
return lval_err("cannot operate on non-number");
}
}
struct lval* x = lval_pop(v, 0);
if ((strcmp(op, "-") == 0) && v->count == 0) {
x->num = -x->num;
}
while (v->count > 0) {
struct lval* y = lval_pop(v, 0);
if (strcmp(op, "+") == 0) { x->num += y->num; }
if (strcmp(op, "-") == 0) { x->num -= y->num; }
if (strcmp(op, "*") == 0) { x->num *= y->num; }
if (strcmp(op, "/") == 0) {
if (y->num == 0) {
lval_del(x); lval_del(y);
x = lval_err("division by zero!"); break;
}
x->num /= y->num;
}
lval_del(y);
}
lval_del(v); return x;
}
lval_t* builtin_op(lval_t* a, const char* op){
for(int i=0;i< a->count;i++){
if(a->cell[i]->type != LVAL_NUM){
lval_free(a);
return lval_err("Cannot operator non number");
}
}
lval_t* x = lval_pop(a, 0);
if((strcmp(op, "-")==0) && a->count == 0){
x->num = -(x->num);
}
while(a->count > 0){
lval_t* y = lval_pop(a, 0);
if(strcmp(op , "+") == 0) x->num += y->num;
if(strcmp(op , "-") == 0) x->num -= y->num;
if(strcmp(op , "*") == 0) x->num *= y->num;
if(strcmp(op , "/") == 0) {
if(y->num == 0){
lval_free(x);
lval_free(y);
x = lval_err("Divison by Zero");
break;
}
x->num /= y->num;
}
}
lval_free(a);
return x;
}
//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;
}
struct lval* lval_eval_call(struct lenv* e, struct lval* f, struct lval* args) {
if (f->fun_type == LVAL_FUN_BUILTIN) {
return f->builtin(e, args);
}
int given = args->count;
int total = f->args->count;
while (args->count) {
if (f->args->count == 0) {
lval_del(args);
return lval_err(
"Too many arguments. Got %i, expected %i.",
given, total
);
}
struct lval* sym = lval_pop(f->args, 0);
if (strcmp(sym->sym, "&") == 0) {
// varargs
lval_del(sym);
sym = lval_pop(f->args, 0);
lenv_put(f->env, sym->sym, lval_builtin_list(e, args));
lval_del(sym);
break;
}
struct lval* val = lval_pop(args, 0);
lenv_put(f->env, sym->sym, val);
lval_del(sym);
lval_del(val);
}
lval_del(args);
if (f->args->count > 0) {
if (strcmp(f->args->cell[0]->sym, "&") != 0) {
return lval_copy(f);
}
// Got all args except varargs, so produce empty list
struct lval* val = lval_qexp();
lenv_put(f->env, f->args->cell[1]->sym, val);
lval_del(val);
}
f->env->parent = e;
struct lval* sexp = lval_sexp();
lval_add(sexp, lval_copy(f->body));
return lval_builtin_eval(f->env, sexp);
}
static lval * builtin_op(lval *a, char *op) {
/* Ensure all arguments are numbers */
for (int i = 0; i < a->count; i++) {
if (a->cell[i]->type != LVAL_NUM) {
lval_del(a);
return lval_err("Cannot operate on non-number!");
}
}
/* Pop the first element */
lval *x = lval_pop(a, 0);
/* If no arguments and sub then perform unary negation */
if (a->count == 0 && (strcmp(op, "-") == 0)) {
x->num = -x->num;
}
/* while there are still elements remaining */
while (a->count > 0) {
/* pop the next element */
lval *y = lval_pop(a, 0);
if (strcmp(op, "+") == 0) { x->num += y->num; }
if (strcmp(op, "-") == 0) { x->num -= y->num; }
if (strcmp(op, "*") == 0) { x->num *= y->num; }
if (strcmp(op, "/") == 0) {
if (y->num == 0) {
lval_del(x);
lval_del(y);
x = lval_err("Division by zero!");
break;
}
x->num /= y->num;
}
if (strcmp(op, "%") == 0) {
if (y->num == 0) {
lval_del(x);
lval_del(y);
x = lval_err("Division by zero!");
break;
}
x->num %= y->num;
}
if (strcmp(op, "^") == 0) { x->num = pow(x->num, y->num); }
lval_del(y);
}
lval_del(a);
return x;
}
struct lval* lval_builtin_join(struct lenv* e, struct lval* v) {
for (int i = 0; i < v->count; i++) {
LTYPE(v, LVAL_QEXP, i, "join");
}
struct lval* x = lval_pop(v, 0);
while (v->count) {
x = lval_join(x, lval_pop(v, 0));
}
lval_del(v);
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) {
lval* y = lval_pop(a, 0);
x = lval_join(x, y);
}
lval_del(a);
return x;
}
lval* builtin_join(lval* a) {
for (int i = 0; i < a->count; i++) {
LASSERT(a, a->cell[i]->type == LVAL_QEXPR, "join takes qexpr");
}
lval* x = lval_pop(a, 0);
while (a->count) {
x = lval_join(x, lval_pop(a, 0));
}
lval_del(a);
return x;
}
//Compute builtin operators
lval* builtin_op(lenv* e, lval* a, char* op) {
//Ensure all args are numbers
for (int i = 0; i < a->count; i++) {
if (a->cell[i]->type != LVAL_NUM) {
lval_del(a);
return lval_err("Function %s cannot operate on non-number, argument %i", op, i);
}
}
//Pop top of list
lval* x = lval_pop(a, 0);
//Unary negation
if ((strcmp(op, "-") == 0) && a->count == 0) { x->num = -x->num; }
//While list has elems, pop and process operators
while (a->count > 0) {
lval* y = lval_pop(a, 0);
if (strcmp(op, "+") == 0) { x->num += y->num; }
if (strcmp(op, "-") == 0) { x->num -= y->num; }
if (strcmp(op, "*") == 0) { x->num *= y->num; }
if (strcmp(op, "^") == 0) { x->num = pow(x->num, y->num); }
if (strcmp(op, "/") == 0) {
if (y->num == 0) {
lval_del(x);
lval_del(y);
return lval_err("Divide by zero.");
} else {
x->num /= y->num;
}
}
if (strcmp(op, "%") == 0) {
if (y->num == 0) {
lval_del(x);
lval_del(y);
return lval_err("Divide by zero.");
} else {
x->num %= y->num;
}
}
//Done with elem, remove
lval_del(y);
}
//Remove input expression and return result
lval_del(a);
return x;
}
// Combine multiple qexprs
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(x, lval_pop(a, 0));
lval_del(a);
return x;
}
static lval * builtin_join(lval *a) {
for (int i = 0; i < a->count; i++) {
LASSERT(a, a->cell[i]->type == LVAL_QEXPR,
"Function 'join' passed incorrect type!");
}
lval *x = lval_pop(a, 0);
while (a->count) {
x = lval_join(x, lval_pop(a, 0));
}
lval_del(a);
return x;
}
lval* builtin_join(lval* a) {
// For each cell in 'y' add it to 'x'
for (int i = 0; i < a->count; i++) {
LASSERT(a, (a->cell[i]->type == LVAL_QEXPR), "Function 'join' passed incorrect type.");
}
lval* x = lval_pop(a, 0);
while (a->count) {
x = lval_join(x, lval_pop(a, 0));
}
lval_del(a);
return x;
}
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;
}
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_join(lval* a, lval* b) {
while(b->cell_count > 0) {
lval_add(a, lval_pop(b,0));
}
lval_delete(b);
return a;
}
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;
}
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(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(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;
}
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* 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_join(struct lval* v, struct lval* x) {
while (x->count) {
v = lval_add(v, lval_pop(x, 0));
}
lval_del(x);
return v;
}
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_op(lval* a, char* op) {
// Ensure all arguments are numbers
for (int i = 0; i < a->count; i++) {
if (a->cell[i]->type != LVAL_NUM) {
lval_del(a);
return lval_err("Cannot operate on non number!");
}
}
// Pop the first element
lval* x = lval_pop(a, 0);
// If no arguments and sub then perform unary negation
if ((strcmp(op, "-") == 0) && a->count == 0) {
x->num = -x->num;
}
// While there are still elements remaining
while (a->count > 0) {
// Pop the next element
lval* y = lval_pop(a, 0);
// Perform operation
if (strcmp(op, "+") == 0) { x->num += y->num; }
if (strcmp(op, "-") == 0) { x->num -= y->num; }
if (strcmp(op, "*") == 0) { x->num *= y->num; }
if (strcmp(op, "/") == 0) {
if (y->num == 0) {
lval_del(x); lval_del(y);
x = lval_err("Division by zero!");
break;
}
x->num /= y->num;
}
if (strcmp(op, "\%") == 0) {
if (y->num == 0) {
lval_del(x); lval_del(y);
x = lval_err("Division by zero!");
break;
}
x->num = x->num%y->num;
}
// Delete element now finished with
lval_del(y);
}
lval* lval_join(lval* x, lval* y) {
while (y->count) {
x = lval_add(x, lval_pop(y, 0));
}
lval_del(y);
return x;
}
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;
}