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);
}
}
//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 * ast_read(mpc_ast_t *t) {
int i;
lval *x;
if (strstr(t->tag, "number")) return ast_read_num(t);
if (strstr(t->tag, "symbol")) {
if (!strcmp(t->contents, "true")) {
return lval_boolean(1);
}
else if (!strcmp(t->contents, "false")) {
return lval_boolean(0);
}
else {
return lval_sym(t->contents);
}
}
if (strstr(t->tag, "string")) {
ssize_t sz = strlen(t->contents) + 1 - 2 /* quotes */;
char *unescaped = malloc(sz);
memcpy(unescaped, t->contents+1, sz);
unescaped[sz-1] = '\0';
unescaped = mpcf_unescape(unescaped);
x = lval_str(unescaped);
free(unescaped);
return x;
}
if (strstr(t->tag, "comment")) return NULL;
if (strstr(t->tag, "qexpr")) {
x = lval_qexpr();
}
else {
assert(
(strcmp(t->tag, ">") == 0) ||
strstr(t->tag, "sexpr")
);
x = lval_sexpr();
}
for (i = 0; i < t->children_num; ++i) {
lval *v;
if (
(strlen(t->children[i]->contents) == 1) &&
strstr("(){}", t->children[i]->contents)
) continue;
if (!strcmp(t->children[i]->tag, "regex")) continue;
v = ast_read(t->children[i]);
if(v) lval_append(x, v);
}
return x;
}
lval *lval_read(mpc_ast_t *t) {
if (strstr(t->tag, "long")) {
return lval_read_long(t);
}
if (strstr(t->tag, "double")) {
return lval_read_double(t);
}
if (strstr(t->tag, "symbol")) {
return lval_sym(t->contents);
}
lval *x = NULL;
if (strcmp(t->tag, ">") == 0) {
x = lval_sexpr();
}
if (strstr(t->tag, "sexpr")) {
x = lval_sexpr();
}
if (strstr(t->tag, "qexpr")) {
x = lval_qexpr();
}
for (int i = 0; i < t->children_num; i++) {
mpc_ast_t *child = t->children[i];
char *contents = child->contents;
if (strcmp(contents, "(") == 0) {
continue;
}
if (strcmp(contents, ")") == 0) {
continue;
}
if (strcmp(contents, "{") == 0) {
continue;
}
if (strcmp(contents, "}") == 0) {
continue;
}
if (strcmp(child->tag, "regex") == 0) {
continue;
}
x = lval_add(x, lval_read(child));
}
return x;
}
lval* lval_read(mpc_ast_t* t) {
if (strstr(t->tag, "number")) { return lval_read_num(t); }
if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); }
lval* x = NULL;
if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); }
if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); }
if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); }
for (int i = 0; i < t->children_num; i++) {
if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
if (strcmp(t->children[i]->tag, "regex") == 0) { continue; }
x = lval_add(x, lval_read(t->children[i]));
}
return x;
}
static lval * lval_read(mpc_ast_t *t) {
if (strstr(t->tag, "number")) { return lval_read_num(t); }
if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); }
/* if root (>) or sexpr then create empty list */
lval *x = NULL;
if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); }
if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); }
if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); }
/* fill this list with any valid expression contained within */
for (int i = 0; i < t->children_num; i++) {
if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
if (strcmp(t->children[i]->tag, "regex") == 0) { continue; }
x = lval_add(x, lval_read(t->children[i]));
}
return x;
}
lval* lval_read(mpc_ast_t* t)
{
if (strstr(t->tag, "number")) { return lval_read_num(t); }
if (strstr(t->tag, "symbol")) { return lval_symbol(t->contents); }
if (strstr(t->tag, "string")) { return lval_read_str(t); }
// if root (>) or sexpr, cearte an empty lval_sexpr.
lval *x = NULL;
if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); }
if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); }
if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); }
for (int i = 0; i < t->children_num; i++) {
if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
if (strcmp(t->children[i]->tag, "regex") == 0) { continue; }
if (strstr(t->children[i]->tag, "comment")) { continue; }
x = lval_add(x, lval_read(t->children[i]));
}
return x;
}
lval *lval_read(mpc_ast_t *t)
{
// convert symbols and nums to lvals
if (strstr(t->tag, "number")) { return lval_read_num(t); }
if (strstr(t->tag, "symbol")) { return lval_sym(t->contents); }
// if root or sexpr creat empty list
lval *x = NULL;
if (strcmp(t->tag, ">") == 0) { x = lval_sexpr(); }
if (strstr(t->tag, "sexpr")) { x = lval_sexpr(); }
if (strstr(t->tag, "qexpr")) { x = lval_qexpr(); }
// fill list with any valid expr contained within
for (int i = 0; i < t->children_num; i++)
{
if (strcmp(t->children[i]->contents, "(") == 0) { continue; }
if (strcmp(t->children[i]->contents, ")") == 0) { continue; }
if (strcmp(t->children[i]->contents, "{") == 0) { continue; }
if (strcmp(t->children[i]->contents, "}") == 0) { continue; }
if (strcmp(t->children[i]->tag, "regex") == 0) { continue; }
x = lval_add(x, lval_read(t->children[i]));
}
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("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);
}
}
lval *lval_call(lenv *e, lval *f, lval *a){
if (f->builtin){ return f->builtin(e, a); }
int given = a->count;
int required = f->formals->count;
while (a->count){
if (f->formals->count == 0){
lval_del(a);
return lval_err("Function passed too many arguments."
"Expected %d, got %d.", required, given);
}
lval *sym = lval_pop(f->formals, 0);
if (strcmp(sym->sym, "&") == 0){
/* Ensure & is followed by another symbol */
if (f->formals->count != 1){
lval_del(a);
return lval_err("& not followed by single symbol");
}
/* Bound next formal to remaining arguments */
lval *nsym = lval_pop(f->formals, 0);
lenv_set(f->env, nsym, builtin_list(e, a));
lval_del(sym);
lval_del(nsym);
break;
}
/* Take out the argument */
lval *val = lval_pop(a, 0);
/* Bound to sym */
lenv_set(f->env, sym, val);
lval_del(sym);
lval_del(val);
}
lval_del(a);
/* If & remaining in argument list, bound to () */
if (f->formals->count > 0 &&
strcmp(f->formals->cell[0]->sym, "&") == 0){
/* Ensure & is not passed invalidly */
if(f->formals->count != 2){
return lval_err("& not followed by single symbol");
}
/* Delete & */
lval_del(lval_pop(f->formals, 0));
/* pop next formal */
lval *sym = lval_pop(f->formals, 0);
lval *empty = lval_qexpr();
lenv_set(f->env, sym, empty);
lval_del(sym);
lval_del(empty);
}
if (f->formals->count == 0){
f->env->parent = 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. 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);
}
}
