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 *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* 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;
}
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;
}
lval eval_op(lval x, char* op, lval y) {
/* If either value is an error return it */
if (x.type == LVAL_ERR) { return x; }
if (y.type == LVAL_ERR) { return y; }
/* Otherwise do maths on the number values */
if (strcmp(op, "+") == 0) { return lval_num(x.data.num + y.data.num); }
if (strcmp(op, "-") == 0) { return lval_num(x.data.num - y.data.num); }
if (strcmp(op, "*") == 0) { return lval_num(x.data.num * y.data.num); }
if (strcmp(op, "/") == 0) {
/* If second operand is zero return error instead of result */
return y.data.num == 0 ? lval_err(LERR_DIV_ZERO) : lval_num(x.data.num - y.data.num);
}
if (strcmp(op, "%") == 0) { return lval_num(x.data.num % y.data.num); }
if (strcmp(op, "^") == 0) { return lval_num(pow(x.data.num, y.data.num)); }
if (strcmp(op, "min") == 0) {
return x.data.num < y.data.num ? lval_num(x.data.num) : lval_num(y.data.num);
}
if (strcmp(op, "max") == 0) {
return x.data.num > y.data.num ? lval_num(x.data.num) : lval_num(y.data.num);
}
return lval_err(LERR_BAD_OP);
}
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);
}
}
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;
}
lval eval_op(lval x, char* op, lval y) {
if (x.type == LVAL_ERR) { return x; }
if (y.type == LVAL_ERR) { return y; }
// Otherwise do maths on the number values
if (strcmp(op, "+") == 0) { return lval_num(x.num + y.num)}
if (strcmp(op, "-") == 0) { return lval_num(x.num - y.num)}
if (strcmp(op, "*") == 0) { return lval_num(x.num * y.num)}
if (strcmp(op, "/") == 0) {
return y.num == 0 ? lval_err(LERR_DIV_ZERO): lval_num(x.num / y.num);
}
return lval_err(LERR_BAD_OP);
}
//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;
}
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;
}
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 * ast_load_eval(char* fn, lenv *env) {
lval *r;
mpc_result_t parsed;
lval *ast;
lval *result;
if (mpc_parse_contents(fn, Lispy, &parsed)) {
ast = ast_read(parsed.output);
mpc_ast_delete(parsed.output);
while (ast->expr->count) {
result = lval_eval(expr_pop(ast->expr, 0), env);
if (result->type == LVAL_ERR) lval_println(result);
lval_del(result);
}
lval_del(ast);
r = lval_sexpr();
}
else {
char *err = mpc_err_string(parsed.error);
mpc_err_delete(parsed.error);
r = lval_err(err);
free(err);
}
return r;
}
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_read_num(mpc_ast_t* t) {
errno = 0;
long x = strtol(t->contents, NULL, 10);
return errno != ERANGE
? lval_num(x)
: lval_err("Invalid Number!");
}
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_read(mpc_ast_t* node) {
// Upwrap top-level form as a single expression
if (strcmp(node->tag, ">") == 0) {
return lval_read(node->children[1]);
}
if (strstr(node->tag, "number")) {
return lval_read_num(node->contents);
}
if (strstr(node->tag, "symbol")) {
return lval_sym(node->contents);
}
if (strstr(node->tag, "bool")) {
return lval_read_bool(node->contents);
}
struct lval* x;
if (strstr(node->tag, "sexp")) {
x = lval_sexp();
}
else if (strstr(node->tag, "qexp")) {
x = lval_qexp();
}
else {
return lval_err("Unexpected node: %s", node->tag);
}
for (int i = 0; i < node->children_num; i++) {
if (read_ignore(node->children[i])) continue;
x = lval_add(x, lval_read(node->children[i]));
}
return x;
}
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_t* builtin(lval_t* a,const char* func){
if(strcmp("head", func) == 0) return builtin_head(a);
if(strcmp("tail" ,func) == 0) return builtin_tail(a);
if(strstr("+-/*", func) == 0) return builtin_op(a, func);
lval_free(a);
return lval_err("Unknown Function");
}
/* Use operator string to see which operation to perform */
lval eval_op(lval x, char* op, lval y){
/* If either values is an error return it */
if(x.type == LVAL_ERR){ return x; }
if(y.type == LVAL_ERR){ return y; }
if(strcmp(op,"+")==0){ return lval_num(x.num + y.num); }
if(strcmp(op,"-")==0){ return lval_num(x.num - y.num); }
if(strcmp(op,"*")==0){ return lval_num(x.num * y.num); }
if(strcmp(op,"/")==0){
/* If second operand is zero return error */
return y.num == 0 ? lval_err(LERR_DIV_ZERO):lval_num(x.num/y.num);
}
return lval_err(LERR_BAD_OP);
}
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;
}
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);
}
lval* lval_read_num(const mpc_ast_t* t) {
errno = 0;
uint64_t x = strtol(t->contents, NULL, 10);
return errno != ERANGE
? lval_num(x)
: lval_err("invalid number");
}
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* 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;
}
/* Delete element now finished with */
lval_del(y);
}
/* Delete input expression and return result */
lval_del(a);
return x;
}
lval eval_op(lval x, char* op, lval y) {
if (x.type == LVAL_ERR) { return x; }
if (y.type == LVAL_ERR) { return y; }
if (strcmp(op, "+") == 0) { return lval_num(x.num + y.num); }
if (strcmp(op, "-") == 0) { return lval_num(x.num - y.num); }
if (strcmp(op, "*") == 0) { return lval_num(x.num * y.num); }
if (strcmp(op, "/") == 0) {
return y.num == 0 ? lval_err(LERR_DIV_ZERO) : lval_num(x.num / y.num);
}
if (strcmp(op, "%") == 0) {
return y.num == 0 ? lval_err(LERR_DIV_ZERO) : lval_num(x.num % y.num);
}
if (strcmp(op, "^") == 0) { return lval_num(pow(x.num, y.num)); }
if (strcmp(op, "min") == 0) { return x.num < y.num ? lval_num(x.num) : lval_num(y.num); }
if (strcmp(op, "max") == 0) { return x.num > y.num ? lval_num(x.num) : lval_num(y.num); }
return lval_err(LERR_BAD_OP);
}
struct lval* lval_read_num(char* value) {
errno = 0;
long x = strtol(value, NULL, 10);
if (errno == 0) {
return lval_num(x);
} else {
return lval_err("Unknown number %s", value);
}
}
struct lval* lval_read_bool(char* value) {
if (strcmp(value, "#t") == 0) {
return lval_bool(1);
}
if (strcmp(value, "#f") == 0) {
return lval_bool(0);
}
return lval_err("Unknown boolean %s", value);
}
lval* builtin(lval* a, char* func) {
if (strcmp("join", func) == 0) { return builtin_join(a); }
if (strcmp("list", func) == 0) { return builtin_list(a); }
if (strcmp("eval", func) == 0) { return builtin_eval(a); }
if (strcmp("tail", func) == 0) { return builtin_tail(a); }
if (strcmp("head", func) == 0) { return builtin_head(a); }
if (strstr("+-/*", func)) { return builtin_op(a, func); }
lval_del(a);
return lval_err("Unknown Function!");
}
lval* builtin_op(lval* a, char* op) {
for (int i = 0; i < a->count; i++) {
if (a->cell[i]->type != LVAL_NUM) {
lval_free(a);
return lval_err("Cannot operate on no-number!");
}
}
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) {
x = lval_err("Division by zero!");
break;
}
x->num /= y->num;
}
if (strcmp(op, "%") == 0) {
if (y->num == 0) {
x = lval_err("Division by zero!");
break;
}
x->num %= y->num;
}
lval_free(y);
}
lval_free(a);
return x;
}