factor out basic standard procedures (+, -, cons, car...) into separate module

7 files changed, 250 insertions, 204 deletions

diff --git a/Makefile b/Makefile
index ad69623..3b7dee5 100644
--- a/Makefile
+++ b/Makefile
@@ -8,9 +8,10 @@ OBJS	= lisp.o lisp.tab.o lex.yy.o
 MODULE_LIBS = -lpq
 MODULE_SRC  = $(wildcard modules/*.c)
 MODULE_SO   = $(MODULE_SRC:.c=.so)
+STD_MODULES = modules/std_lib.so
 .SUFFIXES:
 
-main: main.c $(OBJS)
+main: main.c $(OBJS) $(STD_MODULES)
 	$(CC) $(CFLAGS) -o $@ main.c $(OBJS) $(LIBS)
 
 lisp.o: lisp.c lisp_api.h lisp.h lex.yy.o
@@ -31,7 +32,7 @@ lex.yy.o: lex.yy.c
 clean:
 	rm -f *.o main test lisp.tab.c lisp.tab.h lex.yy.c lex.yy.h modules/*.so
 
-test: test.o $(OBJS)
+test: test.o $(OBJS) $(STD_MODULES)
 	$(CC) $(CFLAGS) -o $@ test.o $(OBJS) $(LIBS)
 	./test
 	
diff --git a/lisp.c b/lisp.c
index 88ff472..e1f09dd 100644
--- a/lisp.c
+++ b/lisp.c
@@ -334,161 +334,6 @@ value *apply(value *lval, value *args) {
 	return make_lambda(sub_env, params, lval->as.lambda.body);
 }
 
-value *procedure_cons(env *e, value *args) {
-	value *v = eval(e, car(args));
-	return cons(v, eval(e, car(cdr(args))));
-}
-
-value *procedure_car(env *e, value *args) {
-	return car(eval(e, car(args)));
-}
-
-value *procedure_cdr(env *e, value *args) {
-	return cdr(eval(e, car(args)));
-}
-
-value *procedure_reverse(env *e, value *args) {
-	return reverse(eval(e, car(args)));
-}
-
-value *procedure_isnull(env *e, value *args) {
-	value *v = eval(e, car(args));
-	if(v->type == VT_NIL) {
-		return make_int(1);
-	}
-	return make_nil();
-}
-
-int value_eq(value *a, value *b) {
-	if(a->type != b->type){
-		return 0;
-	}
-	if(a == b){
-		return 1;
-	}
-	switch (a->type) {
-		case VT_INT: return a->as.i == b->as.i;
-		case VT_DOUBLE: return a->as.d == b->as.d;
-		case VT_SYMBOL: return !strcmp(a->as.sym, b->as.sym);
-		case VT_STRING: return !strcmp(a->as.sym, b->as.sym);
-		case VT_NIL: return 1;
-		case VT_PAIR:
-			return value_eq(car(a), car(b)) &&
-				value_eq(cdr(a), cdr(b));
-		case VT_LAMBDA:
-		case VT_PROCEDURE:
-		default:
-			return 0;
-	}
-	return 1;
-}
-
-value *procedure_equal(env *e, value *args) {
-	value *v_prev = eval(e, car(args));
-
-	args = cdr(args);
-	while (args->type == VT_PAIR) {
-		value *v_cur = eval(e, car(args));
-		if (!value_eq(v_prev, v_cur)) {
-			return make_nil();
-		}
-		v_prev = v_cur;
-		args = cdr(args);
-	}
-
-	return make_int(1);
-}
-
-value *apply_to_nums(env *e, value *args, double (*fn)(double, double)) {
-	double result;
-	value *v = eval(e, car(args));
-	if (v->type == VT_INT) {
-		result = v->as.i;
-	} else if (v->type == VT_DOUBLE) {
-		result = v->as.d;
-	} else {
-		printf("not a number: ");
-		println_value(v);
-		return make_nil();
-	}
-
-	args = cdr(args);
-	while (args->type == VT_PAIR) {
-		v = eval(e, car(args));
-		if (v->type == VT_INT) {
-			result = fn(result, v->as.i);
-		} else if (v->type == VT_DOUBLE) {
-			result = fn(result, v->as.d);
-		} else {
-			printf("not a number: ");
-			println_value(v);
-			return make_nil();
-		}
-		args = cdr(args);
-	}
-
-	if(is_integer(result)){
-		return make_int((int) result);
-	}
-	return make_double(result);
-}
-
-double add_fn(double x, double y) { return x+y; }
-value *procedure_add(env *e, value *args) {
-	return apply_to_nums(e, args, add_fn);
-}
-
-double sub_fn(double x, double y) { return x-y; }
-value *procedure_sub(env *e, value *args) {
-	return apply_to_nums(e, args, sub_fn);
-}
-
-double mul_fn(double x, double y) { return x*y; }
-value *procedure_mul(env *e, value *args) {
-	return apply_to_nums(e, args, mul_fn);
-}
-
-double div_fn(double x, double y) { return x/y; }
-value *procedure_div(env *e, value *args) {
-	return apply_to_nums(e, args, div_fn);
-}
-
-value *procedure_lt(env *e, value *args) {
-	double prev_num;
-	value *v = eval(e, car(args));
-
-	if (v->type == VT_INT) {
-		prev_num = v->as.i;
-	} else if (v->type == VT_DOUBLE) {
-		prev_num = v->as.d;
-	} else {
-		printf("not a number: ");
-		println_value(v);
-		return make_nil();
-	}
-
-	args = cdr(args);
-	while (args->type == VT_PAIR) {
-		v = eval(e, car(args));
-		double cur_num;
-		if (v->type == VT_INT) {
-			cur_num = v->as.i;
-		} else if (v->type == VT_DOUBLE) {
-			cur_num = v->as.d;
-		} else {
-			printf("not a number: ");
-			println_value(v);
-			return make_nil();
-		}
-		if(prev_num >= cur_num) {
-			return make_nil();
-		}
-		prev_num = cur_num;
-		args = cdr(args);
-	}
-	return make_int(1);
-}
-
 value *procedure_load_module(env *e, value *args) {
 	value *fst_arg = eval(e, car(args));
 
diff --git a/lisp.h b/lisp.h
index ef4505a..a747b8d 100644
--- a/lisp.h
+++ b/lisp.h
@@ -23,19 +23,6 @@ value *eval_pair(env *e, value *val);
 
 value *apply(value *lambda, value *args);
 
-value *procedure_cons(env *e, value *args);
-value *procedure_car(env *e, value *args);
-value *procedure_cdr(env *e, value *args);
-value *procedure_reverse(env *e, value *args);
-value *procedure_isnull(env *e, value *args);
-value *procedure_equal(env *e, value *args);
-value *procedure_add(env *e, value *args);
-value *procedure_sub(env *e, value *args);
-value *procedure_mul(env *e, value *args);
-value *procedure_div(env *e, value *args);
-value *procedure_lt(env *e, value *args);
 value *procedure_load_module(env *e, value *args);
 
-int is_integer(double x);
-
 #endif
diff --git a/lisp_api.h b/lisp_api.h
index 66ad231..6cc6588 100644
--- a/lisp_api.h
+++ b/lisp_api.h
@@ -61,4 +61,6 @@ typedef struct {
 
 module_export *module_init();
 
+int is_integer(double x);
+
 #endif
diff --git a/main.c b/main.c
index 86aa69d..84d585c 100644
--- a/main.c
+++ b/main.c
@@ -94,19 +94,8 @@ void init_readline() {
 int main(int argc, char **argv) {
 	// init global env
 	global_env = env_create(NULL);
-	env_define(global_env, "cons", make_procedure(procedure_cons));
-	env_define(global_env, "car", make_procedure(procedure_car));
-	env_define(global_env, "cdr", make_procedure(procedure_cdr));
-	env_define(global_env, "reverse", make_procedure(procedure_reverse));
-	env_define(global_env, "null?", make_procedure(procedure_isnull));
-	env_define(global_env, "equal?", make_procedure(procedure_equal));
-	env_define(global_env, "+", make_procedure(procedure_add));
-	env_define(global_env, "-", make_procedure(procedure_sub));
-	env_define(global_env, "*", make_procedure(procedure_mul));
-	env_define(global_env, "/", make_procedure(procedure_div));
-	env_define(global_env, "<", make_procedure(procedure_lt));
-
 	env_define(global_env, "load_module", make_procedure(procedure_load_module));
+	procedure_load_module(global_env, cons(make_string("modules/std_lib.so"), make_nil()));
 
 	// evaluate files
 	for(int i = 1; i < argc; i++) {
diff --git a/modules/std_lib.c b/modules/std_lib.c
new file mode 100644
index 0000000..7964422
--- /dev/null
+++ b/modules/std_lib.c
@@ -0,0 +1,193 @@
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+#include "../lisp_api.h"
+
+value *procedure_cons(env *e, value *args) {
+	value *v = eval(e, car(args));
+	return cons(v, eval(e, car(cdr(args))));
+}
+
+value *procedure_car(env *e, value *args) {
+	return car(eval(e, car(args)));
+}
+
+value *procedure_cdr(env *e, value *args) {
+	return cdr(eval(e, car(args)));
+}
+
+value *procedure_reverse(env *e, value *args) {
+	return reverse(eval(e, car(args)));
+}
+
+value *procedure_isnull(env *e, value *args) {
+	value *v = eval(e, car(args));
+	if(v->type == VT_NIL) {
+		return make_int(1);
+	}
+	return make_nil();
+}
+
+int value_eq(value *a, value *b) {
+	if(a->type != b->type){
+		return 0;
+	}
+	if(a == b){
+		return 1;
+	}
+	switch (a->type) {
+		case VT_INT: return a->as.i == b->as.i;
+		case VT_DOUBLE: return a->as.d == b->as.d;
+		case VT_SYMBOL: return !strcmp(a->as.sym, b->as.sym);
+		case VT_STRING: return !strcmp(a->as.sym, b->as.sym);
+		case VT_NIL: return 1;
+		case VT_PAIR:
+			return value_eq(car(a), car(b)) &&
+				value_eq(cdr(a), cdr(b));
+		case VT_LAMBDA:
+		case VT_PROCEDURE:
+		default:
+			return 0;
+	}
+	return 1;
+}
+
+value *procedure_equal(env *e, value *args) {
+	value *v_prev = eval(e, car(args));
+
+	args = cdr(args);
+	while (args->type == VT_PAIR) {
+		value *v_cur = eval(e, car(args));
+		if (!value_eq(v_prev, v_cur)) {
+			return make_nil();
+		}
+		v_prev = v_cur;
+		args = cdr(args);
+	}
+
+	return make_int(1);
+}
+
+value *apply_to_nums(env *e, value *args, double (*fn)(double, double)) {
+	double result;
+	value *v = eval(e, car(args));
+	if (v->type == VT_INT) {
+		result = v->as.i;
+	} else if (v->type == VT_DOUBLE) {
+		result = v->as.d;
+	} else {
+		printf("not a number: ");
+		println_value(v);
+		return make_nil();
+	}
+
+	args = cdr(args);
+	while (args->type == VT_PAIR) {
+		v = eval(e, car(args));
+		if (v->type == VT_INT) {
+			result = fn(result, v->as.i);
+		} else if (v->type == VT_DOUBLE) {
+			result = fn(result, v->as.d);
+		} else {
+			printf("not a number: ");
+			println_value(v);
+			return make_nil();
+		}
+		args = cdr(args);
+	}
+
+	if(is_integer(result)){
+		return make_int((int) result);
+	}
+	return make_double(result);
+}
+
+double add_fn(double x, double y) { return x+y; }
+value *procedure_add(env *e, value *args) {
+	return apply_to_nums(e, args, add_fn);
+}
+
+double sub_fn(double x, double y) { return x-y; }
+value *procedure_sub(env *e, value *args) {
+	return apply_to_nums(e, args, sub_fn);
+}
+
+double mul_fn(double x, double y) { return x*y; }
+value *procedure_mul(env *e, value *args) {
+	return apply_to_nums(e, args, mul_fn);
+}
+
+double div_fn(double x, double y) { return x/y; }
+value *procedure_div(env *e, value *args) {
+	return apply_to_nums(e, args, div_fn);
+}
+
+value *procedure_lt(env *e, value *args) {
+	double prev_num;
+	value *v = eval(e, car(args));
+
+	if (v->type == VT_INT) {
+		prev_num = v->as.i;
+	} else if (v->type == VT_DOUBLE) {
+		prev_num = v->as.d;
+	} else {
+		printf("not a number: ");
+		println_value(v);
+		return make_nil();
+	}
+
+	args = cdr(args);
+	while (args->type == VT_PAIR) {
+		v = eval(e, car(args));
+		double cur_num;
+		if (v->type == VT_INT) {
+			cur_num = v->as.i;
+		} else if (v->type == VT_DOUBLE) {
+			cur_num = v->as.d;
+		} else {
+			printf("not a number: ");
+			println_value(v);
+			return make_nil();
+		}
+		if(prev_num >= cur_num) {
+			return make_nil();
+		}
+		prev_num = cur_num;
+		args = cdr(args);
+	}
+	return make_int(1);
+}
+
+module_export *module_init() {
+	//exports[i].name = "xxx"
+	//exports[i].v = make_procedure(xxx);
+	static module_export exports[12];
+
+	exports[0].name = "cons";
+	exports[0].v = make_procedure(procedure_cons);
+	exports[1].name = "car";
+	exports[1].v = make_procedure(procedure_car);
+	exports[2].name = "cdr";
+	exports[2].v = make_procedure(procedure_cdr);
+	exports[3].name = "reverse";
+	exports[3].v = make_procedure(procedure_reverse);
+	exports[4].name = "null?";
+	exports[4].v = make_procedure(procedure_isnull);
+	exports[5].name = "equal?";
+	exports[5].v = make_procedure(procedure_equal);
+	exports[6].name = "+";
+	exports[6].v = make_procedure(procedure_add);
+	exports[7].name = "-";
+	exports[7].v = make_procedure(procedure_sub);
+	exports[8].name = "*";
+	exports[8].v = make_procedure(procedure_mul);
+	exports[9].name = "/";
+	exports[9].v = make_procedure(procedure_div);
+	exports[10].name = "<";
+	exports[10].v = make_procedure(procedure_lt);
+
+	exports[11].name = NULL;
+	exports[11].v    = NULL;
+
+	return exports;
+}
diff --git a/test.c b/test.c
index 4360bef..95f8666 100644
--- a/test.c
+++ b/test.c
@@ -120,7 +120,8 @@ void test_lambda_add() {
 	env *e = env_create(NULL);
 
 	// install +
-	env_define(e, "+", make_procedure(procedure_add));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
+	
 
 	value *expr =
 		cons(
@@ -148,7 +149,7 @@ void test_lambda_add() {
 
 void test_lambda_multiple_args() {
 	env *e = env_create(NULL);
-	env_define(e, "+", make_procedure(procedure_add));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
 
 	value *expr =
 		cons(
@@ -184,7 +185,8 @@ void test_lambda_closure() {
 	//((lambda (y) (+ x y)) 5)
 
 	env *e = env_create(NULL);
-	env_define(e, "+", make_procedure(procedure_add));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
+	
 	env_define(e, "x", make_int(10));
 
 	value *expr =
@@ -213,7 +215,7 @@ void test_lambda_closure() {
 void test_nested_lambdas() {
 	// (((lambda (x) (lambda (y) (+ x y))) 3) 4)
 	env *e = env_create(NULL);
-	env_define(e, "+", make_procedure(procedure_add));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
 
 	value *expr =
 		cons(
@@ -274,10 +276,7 @@ void test_lambda_does_not_modify_outer_env() {
 void test_recursive_factorial() {
 	env *e = env_create(NULL);
 
-	env_define(e, "+", make_procedure(procedure_add));
-	env_define(e, "-", make_procedure(procedure_sub));
-	env_define(e, "*", make_procedure(procedure_mul));
-	env_define(e, "<", make_procedure(procedure_lt));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
 
 	/*
 	(define fact
@@ -349,10 +348,11 @@ void test_recursive_factorial() {
 
 void test_eq_ints() {
 	env *e = env_create(NULL);
-	env_define(e, "eq", make_procedure(procedure_equal));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
+	
 
 	value *expr =
-		cons(make_symbol("eq"),
+		cons(make_symbol("equal?"),
 			cons(make_int(3),
 				cons(make_int(3), make_nil())
 			)
@@ -366,10 +366,11 @@ void test_eq_ints() {
 
 void test_eq_ints_false() {
 	env *e = env_create(NULL);
-	env_define(e, "eq", make_procedure(procedure_equal));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
+	
 
 	value *expr =
-		cons(make_symbol("eq"),
+		cons(make_symbol("equal?"),
 			cons(make_int(3),
 				cons(make_int(4), make_nil())
 			)
@@ -381,10 +382,11 @@ void test_eq_ints_false() {
 
 void test_eq_symbols() {
 	env *e = env_create(NULL);
-	env_define(e, "eq", make_procedure(procedure_equal));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
+	
 
 	value *expr =
-		cons(make_symbol("eq"),
+		cons(make_symbol("equal?"),
 			cons(make_symbol("foo"),
 				cons(make_symbol("foo"), make_nil())
 			)
@@ -396,7 +398,8 @@ void test_eq_symbols() {
 
 void test_eq_lists() {
 	env *e = env_create(NULL);
-	env_define(e, "eq", make_procedure(procedure_equal));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
+	
 
 	value *list1 =
 		cons(make_int(1),
@@ -409,7 +412,7 @@ void test_eq_lists() {
 		);
 
 	value *expr =
-		cons(make_symbol("eq"),
+		cons(make_symbol("equal?"),
 			cons(list1,
 				cons(list2, make_nil())
 			)
@@ -421,7 +424,8 @@ void test_eq_lists() {
 
 void test_null_true() {
 	env *e = env_create(NULL);
-	env_define(e, "null?", make_procedure(procedure_isnull));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
+	
 
 	value *expr =
 		cons(make_symbol("null?"),
@@ -434,7 +438,8 @@ void test_null_true() {
 
 void test_null_false() {
 	env *e = env_create(NULL);
-	env_define(e, "null?", make_procedure(procedure_isnull));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
+	
 
 	value *expr =
 		cons(make_symbol("null?"),
@@ -450,7 +455,7 @@ void test_null_false() {
 
 void test_if_true() {
 	env *e = env_create(NULL);
-	env_define(e, "<", make_procedure(procedure_lt));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
 
 	value *expr =
 		cons(make_symbol("if"),
@@ -503,7 +508,7 @@ void test_if_short_circuit() {
 
 void test_add_multiple_args() {
 	env *e = env_create(NULL);
-	env_define(e, "+", make_procedure(procedure_add));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
 
 	value *expr =
 		cons(make_symbol("+"),
@@ -520,7 +525,7 @@ void test_add_multiple_args() {
 
 void test_lt_chain() {
 	env *e = env_create(NULL);
-	env_define(e, "<", make_procedure(procedure_lt));
+	procedure_load_module(e, cons(make_string("modules/std_lib.so"), make_nil()));
 
 	value *expr =
 		cons(make_symbol("<"),
@@ -536,33 +541,57 @@ void test_lt_chain() {
 }
 
 int main(void) {
+	printf("lol 1\n");
 	test_make_int();
+	printf("lol 2\n");
 	test_cons_car_cdr();
+	printf("lol 3\n");
 	test_env_define_lookup();
+	printf("lol 4\n");
 	test_env_parent_lookup();
+	printf("lol 5\n");
 	test_eval_literal();
+	printf("lol 6\n");
 	test_eval_symbol();
+	printf("lol 7\n");
 	test_define();
+	printf("lol 8\n");
 	test_lambda_identity();
+	printf("lol 9\n");
 	test_lambda_add();
+	printf("lol 10\n");
 	test_lambda_multiple_args();
+	printf("lol 11\n");
 	test_lambda_closure();
+	printf("lol 12\n");
 	test_nested_lambdas();
+	printf("lol 13\n");
 	test_lambda_does_not_modify_outer_env();
+	printf("lol 14\n");
 	test_recursive_factorial();
+	printf("lol 15\n");
 	test_eq_ints();
+	printf("lol 16\n");
 	test_eq_ints_false();
+	printf("lol 17\n");
 	test_eq_symbols();
+	printf("lol 18\n");
 	test_eq_lists();
+	printf("lol 19\n");
 	test_null_true();
+	printf("lol 20\n");
 	test_null_false();
+	printf("lol 21\n");
 	test_if_true();
+	printf("lol 22\n");
 	test_if_false();
+	printf("lol 23\n");
 	test_if_short_circuit();
+	printf("lol 24\n");
 	test_add_multiple_args();
+	printf("lol 25\n");
 	test_lt_chain();
 
-
 	printf("\nTests run: %d\n", tests_run);
 	printf("Tests failed: %d\n", tests_failed);