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);
}
}
lval* lval_call(lenv* env, lval* function, lval* args) {
lval_func* func = function->data.func;
if (func->builtin != NULL) {
return func->builtin(env, args);
}
//Check arg counts
LASSERT(args, func->formals->cell_count <= args->cell_count, LERR_SYNTAX,
"lambda: insufficient arguments. Expected %ld got %ld", func->formals->cell_count, args->cell_count);
for(int i = 0; i < func->formals->cell_count; i++) {
lenv_put(func->env, func->formals->cell_list[i], args->cell_list[i]);
}
if (func->va != NULL) {
lval* vaArgs = lval_q_expr();
for(int i = func->formals->cell_count; i < args->cell_count; i ++ ) {
lval_add(vaArgs, lval_copy(args->cell_list[i]));
}
lenv_put(func->env, func->va, vaArgs);
lval_delete(vaArgs);
}
lval_delete(args);
func->env->parent = env;
return eval(func->env, lval_add(lval_s_expr(), lval_copy(func->body)));
}
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);
}
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();
}
void lenv_add_builtin(lenv* e, char* name, lbuiltin func){
lval_t* k = lval_sym(name);
lval_t* v = lval_fun(func);
lenv_put(e, k, v);
lval_free(k);
lval_free(v);
}
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();
}
void lenv_def(lenv *e, lval *k, lval *v)
{
while (e->par)
{
e = e->par;
}
lenv_put(e, k, v);
}
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(
"Function passed too many arguments. "
"Got %i, Expected %i.", given, total);
}
lval* sym = lval_pop(f->formals, 0);
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) {
f->env->par = e;
return builtin_eval(
f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
} else {
return lval_copy(f);
}
}
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("Function passed too many arguments\n"
" got %i expected %i", given, total);
}
lval *sym = lval_pop(f->formals, 0);
if (strcmp(sym->sym, "&") == 0)
{
if (f->formals->count != 1)
{
lval_del(a);
return lval_err("Function format invalid\n"
" symbol '&' not followed by single symbol");
}
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("Function format invalid\n"
" symbol '&' not followed by single symbol");
}
lval_del(lval_pop(f->formals, 0));
lval *sym = lval_pop(f->formals, 0);
lval *val = lval_qexpr();
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);
}
}
int lenv_def(lenv* e, lval* k, lval* v)
{
while (e->par)
e = e->par;
return lenv_put(e, k, v);
}
void lenv_add_builtin(struct lenv* e, char* name, lfunc fn) {
struct lval* v = lval_builtin(name, fn);
lenv_put(e, name, v);
lval_del(v);
}
void lenv_def(struct lenv* e, char* sym, struct lval* v) {
while (e->parent) e = e->parent;
lenv_put(e, sym, v);
}
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("Function passed too many arguments. Expected %i, Got %i.", total, given);
}
lval* sym = lval_pop(f->formals, 0);
// Variadic operator
if (strcmp(sym->sym, "&") == 0){
if (f->formals->count != 1) {
lval_del(a);
return lval_err("Function format invalid. "
"Symbol '&' not followed by a single symbol");
}
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(val);
lval_del(sym);
}
lval_del(a);
// If '&' remains in formal list bind to empty list
if (f->formals->count > 0 &&
strcmp(f->formals->cell[0]->sym, "&") == 0) {
if (f->formals->count != 2) {
return lval_err("Function format invalid. "
"Symbol '&' not followed by a single symbol");
}
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(val);
lval_del(sym);
}
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);
}
}
lval* lval_call(lenv* e, lval* f, lval* a) {
/* If Builtin then simply apply that */
if (f->builtin) { return f->builtin(e, a); }
/* Record Argument Counts */
int given = a->count;
int total = f->formals->count;
/* While arguments still remain to be processed */
while (a->count) {
/* If we've ran out of formal arguments to bind */
if (f->formals->count == 0) {
lval_del(a);
return lval_err("Function passed too many arguments. Got %i, Expected %i.", given, total);
}
/* Pop the first symbol from the formals */
lval* sym = lval_pop(f->formals, 0);
/* Special Case to deal with '&' */
if (strcmp(sym->sym, "&") == 0) {
/* Ensure '&' is followed by another symbol */
if (f->formals->count != 1) {
lval_del(a);
return lval_err("Function format invalid. Symbol '&' not followed by single symbol.");
}
/* Next formal should be bound to remaining arguments */
lval* nsym = lval_pop(f->formals, 0);
lenv_put(f->env, nsym, builtin_list(e, a));
lval_del(sym); lval_del(nsym);
break;
}
/* Pop the next argument from the list */
lval* val = lval_pop(a, 0);
/* Bind a copy into the function's environment */
lenv_put(f->env, sym, val);
/* Delete symbol and value */
lval_del(sym); lval_del(val);
}
/* Argument list is now bound so can be cleaned up */
lval_del(a);
/* If '&' remains in formal list it should be bound to empty list */
if (f->formals->count > 0 &&
strcmp(f->formals->cell[0]->sym, "&") == 0) {
/* Check to ensure that & is not passed invalidly. */
if (f->formals->count != 2) {
return lval_err("Function format invalid. Symbol '&' not followed by single symbol.");
}
/* Pop and delete '&' symbol */
lval_del(lval_pop(f->formals, 0));
/* Pop next symbol and create empty list */
lval* sym = lval_pop(f->formals, 0);
lval* val = lval_qexpr();
/* Bind to environment and delete */
lenv_put(f->env, sym, val);
lval_del(sym); lval_del(val);
}
/* If all formals have been bound evaluate */
if (f->formals->count == 0) {
/* Set Function Environment parent to current evaluation Environment */
f->env->par = e;
/* Evaluate and return */
return builtin_eval(f->env, lval_add(lval_sexpr(), lval_copy(f->body)));
} else {
/* Otherwise return partially evaluated function */
return lval_copy(f);
}
}
void lenv_add_builtin(lenv* e, char* name, lbuiltin func) {
lval* k = lval_sym(name);
lval* v = lval_builtin(func);
lenv_put(e, k, v);
lval_del(k); lval_del(v);
}
void lenv_def(lenv* e, lval* k, lval* v) {
/* Iterate till e has no parent */
while (e->par) { e = e->par; }
/* Put value in e */
lenv_put(e, k, v);
}