Refactored error reporting code, started on adding lambda functions

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;

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,
+    LASSERT_TYPE("def", a, 0, LVAL_QEXPR)
-        "Function 'def' passed incorrect type. Got %s, expected %s",
-            ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR))
 
     // First argument is the symbol list
     lval* syms = a->cell[0];
@@ -126,7 +138,7 @@ 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++) {
@@ -136,3 +148,40 @@ 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);
+}

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

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

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_NUM("head", a, 1)
-	LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'head' passed incorrect type. Got %s, expected %s.",
+	LASSERT_TYPE("head", a, 0, LVAL_QEXPR)
-		ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR))
+	LASSERT_NOT_EMPTY("head", a, 0)
-	LASSERT(a, a->cell[0]->count != 0, "Function 'head' passed {}")
 
 	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_NUM("init", a, 1)
-	LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'init' passed incorrect type. Got %s, expeced %s.",
+	LASSERT_TYPE("init", a, 0, LVAL_QEXPR)
-		ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR))
+	LASSERT_NOT_EMPTY("init", a, 0)
-	LASSERT(a, a->cell[0]->count != 0, "Function 'init' passed {}")
-
 	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_NUM("tail", a, 1)
-	LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'tail' passed incorrect type. Got %s, expected %s.",
+	LASSERT_TYPE("tail", a, 0, LVAL_QEXPR)
-		ltype_name(a->cell[0]->type), ltype_name(LVAL_QEXPR))
+	LASSERT_NOT_EMPTY("tail", a, 0)
-	LASSERT(a, a->cell[0]->count != 0, "Function 'tail' passed {}")
 
 	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_NUM("eval", a, 1)
-	LASSERT(a, a->cell[0]->type == LVAL_QEXPR, "Function 'eval' passed incorrect type. Got %s, expected %s.",
+	LASSERT_TYPE("eval", a, 0, LVAL_QEXPR)
-		ltype_name(a->cell[0]->type), ltype_name(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",
+		LASSERT_TYPE("join", a, i, LVAL_QEXPR)
-			ltype_name(a->cell[i]->type), ltype_name(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.",
+	LASSERT_TYPE("len", a, 0, LVAL_QEXPR)
-		ltype_name(a->cell[0]->type), ltype_name(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.",
+	LASSERT_TYPE("cons", a, 1, LVAL_QEXPR)
-		ltype_name(a->cell[1]->type), ltype_name(LVAL_QEXPR))
+	LASSERT_NUM("cons", a, 2)
-	LASSERT(a, a->count == 2, "Function 'cons' passed an incorrect number of arguments. Got %i, expected %i.",
-		a->count, 2)
 	
 	lval* x = lval_qexpr();
 	x = lval_add(x, lval_pop(a, 0));

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, "<function>"); break;
+		case LVAL_FUN: 
+			if (v->builtin) {
+				fprintf(stream, "<function>");
+			} else {
+				fprintf(stream, "(\\ "); flval_print(stream, v->formals);
+				fprintf(stream, " "); flval_print(stream, v->body); fprintf(stream, ")");
+			} break;
 	}
 }
 

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: