diff --git a/lval/base.h b/lval/base.h index 16dd3e7..25216b1 100644 --- a/lval/base.h +++ b/lval/base.h @@ -22,7 +22,12 @@ struct lval { // Error and symbols contain string data char* err; char* sym; - lbuiltin fun; + + // Function + lbuiltin builtin; + lenv* env; + lval* formals; + lval* body; // Count and pointer to a list of lval* int count; diff --git a/lval/environment.c b/lval/environment.c index f1e8f30..5ebc75f 100644 --- a/lval/environment.c +++ b/lval/environment.c @@ -22,6 +22,19 @@ void lenv_del(lenv* e) { free(e); } +lenv* lenv_copy(lenv* e) { + lenv* n = malloc(sizeof(lenv)); + n->count = e->count; + n->syms = malloc(sizeof(char*) * n->count); + n->vals = malloc(sizeof(lval*) * n->count); + for (int i = 0; i < e->count; i++) { + n->syms[i] = malloc(strlen(e->syms[i]) + 1); + strcpy(n->syms[i], e->syms[i]); + n->vals[i] = lval_copy(e->vals[i]); + } + return n; +} + lval* lenv_get(lenv* e, lval* k) { // Iterate over all items in environment for (int i = 0; i < e->count; i++) { @@ -63,7 +76,7 @@ void lenv_put(lenv* e, lval* k, lval* v) { lval* lval_fun(lbuiltin func) { lval* v = malloc(sizeof(lval)); v->type = LVAL_FUN; - v->fun = func; + v->builtin = func; return v; } @@ -96,12 +109,11 @@ void lenv_add_builtins(lenv* e) { lenv_add_builtin(e, "def", builtin_def); lenv_add_builtin(e, "ls", builtin_ls); + lenv_add_builtin(e, "\\", builtin_lambda); } lval* builtin_def(lenv* e, lval* a) { - LASSERT(a, a->cell[0]->type == LVAL_QEXPR, - "Function 'def' passed incorrect type. Got %s, expected %s", - ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR)) + LASSERT_TYPE("def", a, 0, LVAL_QEXPR) // First argument is the symbol list lval* syms = a->cell[0]; @@ -126,8 +138,8 @@ lval* builtin_def(lenv* e, lval* a) { } lval* builtin_ls(lenv* e, lval* a) { - LASSERT(a, a->count == 0, "Function 'ls' passed an incorrect number of arguments. Got %i, expected %i.", a->count, 0) - + LASSERT_NUM("ls", a, 0) + lval* x = lval_qexpr(); for (int i = 0; i < e->count; i++) { lval_add(x, lval_sym(e->syms[i])); @@ -135,4 +147,41 @@ lval* builtin_ls(lenv* e, lval* a) { lval_del(a); return x; +} + +lval* lval_lambda(lval* formals, lval* body) { + lval* v = malloc(sizeof(lval)); + v->type = LVAL_FUN; + + // Set builtin to null + v->builtin = NULL; + + // Build new environment + v->env = lenv_new(); + + // Set formals and body + v->formals = formals; + v->body = body; + return v; +} + +lval* builtin_lambda(lenv* e, lval* a) { + // Check for 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); } \ No newline at end of file diff --git a/lval/environment.h b/lval/environment.h index 622009c..815ecbe 100644 --- a/lval/environment.h +++ b/lval/environment.h @@ -23,6 +23,7 @@ void lenv_add_builtins(lenv* e); lval* builtin_def(lenv* e, lval* a); lval* builtin_ls(lenv* e, lval* a); +lval* builtin_lambda(lenv* e, lval* a); #endif diff --git a/lval/error.h b/lval/error.h index 0d95fb5..2629f4c 100644 --- a/lval/error.h +++ b/lval/error.h @@ -13,4 +13,20 @@ char* ltype_name(int t); return err; \ } +#define LASSERT_TYPE(func, args, index, expect) \ + LASSERT(args, args->cell[index]->type == expect, \ + "Function '%s' passed incorrect type for argument %i. " \ + "Got %s, Expected %s.", \ + func, index, ltype_name(args->cell[index]->type), ltype_name(expect)) + +#define LASSERT_NUM(func, args, num) \ + LASSERT(args, args->count == num, \ + "Function '%s' passed incorrect number of arguments. " \ + "Got %i, Expected %i.", \ + func, args->count, num) + +#define LASSERT_NOT_EMPTY(func, args, index) \ + LASSERT(args, args->cell[index]->count != 0, \ + "Function '%s' passed {} for argument %i.", func, index); + #endif diff --git a/lval/expressions.c b/lval/expressions.c index b15614b..e22f101 100644 --- a/lval/expressions.c +++ b/lval/expressions.c @@ -95,17 +95,16 @@ lval* lval_eval_sexpr(lenv* e, lval* v) { } // If so call the function and return result - lval* result = f->fun(e, v); + lval* result = f->builtin(e, v); lval_del(f); return result; } lval* builtin_headn(lenv* e, lval* a, int n) { - LASSERT(a, a->count == 1, "Function 'head' passed too many arguments. Got %i, Expected %i.", a->count, 1) - LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'head' passed incorrect type. Got %s, expected %s.", - ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR)) - LASSERT(a, a->cell[0]->count != 0, "Function 'head' passed {}") + 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 > n) { lval_del(lval_pop(v, v->count - 1)); } @@ -117,20 +116,17 @@ lval* builtin_head(lenv* e, lval* a) { } lval* builtin_init(lenv* e, lval* a) { - LASSERT(a, a->count == 1, "Function 'init' passed too many arguments") - LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'init' passed incorrect type. Got %s, expeced %s.", - ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR)) - LASSERT(a, a->cell[0]->count != 0, "Function 'init' passed {}") - + LASSERT_NUM("init", a, 1) + LASSERT_TYPE("init", a, 0, LVAL_QEXPR) + LASSERT_NOT_EMPTY("init", a, 0) return builtin_headn(e, a, a->cell[0]->count - 1); } lval* builtin_tail(lenv* e, lval* a) { - LASSERT(a, a->count == 1, "Function 'tail' passed too many arguments. Got %i, expected %i.", a->count, 1) - LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'tail' passed incorrect type. Got %s, expected %s.", - ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR)) - LASSERT(a, a->cell[0]->count != 0, "Function 'tail' passed {}") + 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)); @@ -143,9 +139,8 @@ lval* builtin_list(lenv* e, lval* a) { } lval* builtin_eval(lenv* e, lval* a) { - LASSERT(a, a->count == 1, "Function 'eval' passed too many arguments") - LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'eval' passed incorrect type. Got %s, expected %s.", - ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR)) + LASSERT_NUM("eval", a, 1) + LASSERT_TYPE("eval", a, 0, LVAL_QEXPR) lval* x = lval_take(a, 0); x->type = LVAL_SEXPR; @@ -165,8 +160,7 @@ lval* lval_join(lenv* e, lval* x, lval* y) { lval* builtin_join(lenv* e, lval* a) { for (int i = 0 ; i < a->count; i++) { - LASSERT(a, a->cell[i]->type == LVAL_QEXPR, "Function 'join' passed incorrect type. Got %s, expected %s", - ltype_name(a->cell[i]->type), ltype_name(LVAL_QEXPR)) + LASSERT_TYPE("join", a, i, LVAL_QEXPR) } lval* x = lval_pop(a, 0); @@ -180,8 +174,7 @@ lval* builtin_join(lenv* e, lval* a) { } lval* builtin_len(lenv* e, lval* a) { - LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'len' passed incorrect type. Got %s, expected %s.", - ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR)) + LASSERT_TYPE("len", a, 0, LVAL_QEXPR) lval* x = lval_long(a->cell[0]->count); lval_del(a); @@ -191,10 +184,8 @@ lval* builtin_len(lenv* e, lval* a) { lval* builtin_cons(lenv* e, lval* a) { LASSERT(a, a->cell[0]->type != LVAL_QEXPR, "Function 'cons' passed incorrect type on first argument. Got %s, expected not %s", ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR)) - LASSERT(a, a->cell[1]->type == LVAL_QEXPR, "Function 'cons' passed incorrect type on second argument. Got %s, expected %s.", - ltype_name(a->cell[1]->type), ltype_name(LVAL_QEXPR)) - LASSERT(a, a->count == 2, "Function 'cons' passed an incorrect number of arguments. Got %i, expected %i.", - a->count, 2) + LASSERT_TYPE("cons", a, 1, LVAL_QEXPR) + LASSERT_NUM("cons", a, 2) lval* x = lval_qexpr(); x = lval_add(x, lval_pop(a, 0)); diff --git a/lval/io.c b/lval/io.c index 6780593..c1c9aa8 100644 --- a/lval/io.c +++ b/lval/io.c @@ -31,7 +31,13 @@ void flval_print(FILE* stream, lval* v) { case LVAL_QEXPR: flval_expr_print(stream, v, '{', '}'); break; - case LVAL_FUN: fprintf(stream, ""); break; + case LVAL_FUN: + if (v->builtin) { + fprintf(stream, ""); + } else { + fprintf(stream, "(\\ "); flval_print(stream, v->formals); + fprintf(stream, " "); flval_print(stream, v->body); fprintf(stream, ")"); + } break; } } diff --git a/lval/operations.c b/lval/operations.c index 549a06a..0e6e3f6 100644 --- a/lval/operations.c +++ b/lval/operations.c @@ -62,7 +62,13 @@ void lval_del(lval* v) { switch (v->type) { case LVAL_LONG: break; case LVAL_DOUBLE: break; - case LVAL_FUN: break; + case LVAL_FUN: + if (!v->builtin) { + lenv_del(v->env); + lval_del(v->formals); + lval_del(v->body); + } + break; // Free the string data case LVAL_ERR: free(v->err); break; @@ -92,7 +98,16 @@ lval* lval_copy(lval* v) { // Copy numbers and functions directly case LVAL_LONG: x->data.num = v->data.num; break; case LVAL_DOUBLE: x->data.dec = v->data.dec; break; - case LVAL_FUN: x->fun = v->fun; break; + case LVAL_FUN: + if (v->builtin) { + x->builtin = v->builtin; + } else { + x->builtin = NULL; + x->env = lenv_copy(v->env); + x->formals = lval_copy(v->formals); + x->body = lval_copy(v->body); + } + break; // Copy strings using malloc and strcpy case LVAL_ERR: