add builtins, add pretty printing for lists, fix erroneous symbol x not found for forms (define, lambda ...) add check for head->type == VT_SYMBOL on forms (so a string cannot be misinterpreted as a form symbol), move is_integer from lisp.y to lisp.h/lisp.c

5 files changed, 224 insertions, 40 deletions

diff --git a/lisp.c b/lisp.c
index 357e94c..e111c47 100644
--- a/lisp.c
+++ b/lisp.c
@@ -2,6 +2,7 @@
 #include <stdio.h>
 #include <readline/readline.h>
 #include <readline/history.h>
+#include <math.h>
 #include "lisp.h"
 #include "lex.yy.h"
 #include "lisp.tab.h"
@@ -41,20 +42,21 @@ value *make_nil() {
 }
 
 value *make_lambda(env *e, value *params, value *body) {
-	printf("making lambda:\n");
 	value *l = malloc(sizeof(value));
 	l->type = VT_LAMBDA;
 	l->as.lambda.params = params;
-	printf("params: ");
-	print_value(params);
 	l->as.lambda.body = body;
-	printf("\nbody: ");
-	print_value(body);
-	printf("\n");
 	l->as.lambda.env = e;
 	return l;
 }
 
+value *make_builtin(value *(*fn) (env *, value *)){
+	value *val = malloc(sizeof(value));
+	val->type = VT_BUILTIN;
+	val->as.builtin.fn = fn;
+	return val;
+}
+
 value *cons(value *car, value *cdr) {
 	value *val = malloc(sizeof(value));
 	val->type = VT_PAIR;
@@ -98,10 +100,26 @@ void *print_value(value *val){
 			break;
 
 		case VT_PAIR:
+			// DOTTED:
+			//printf("(");
+			//print_value(val->as.pair.car);
+			//printf(" . ");
+			//print_value(val->as.pair.cdr);
+			//printf(")");
+			
+			// LISTS:
 			printf("(");
-			print_value(val->as.pair.car);
-			printf(" . ");
-			print_value(val->as.pair.cdr);
+			print_value(car(val));
+			value *p_cdr = cdr(val);
+			while (p_cdr->type == VT_PAIR) {
+				printf(" ");
+				print_value(car(p_cdr));
+				p_cdr = cdr(p_cdr);
+			}
+			if(p_cdr->type != VT_NIL) {
+				printf(" . ");
+				print_value(p_cdr);
+			}
 			printf(")");
 			break;
 
@@ -111,7 +129,13 @@ void *print_value(value *val){
 			printf(" ");
 			print_value(val->as.lambda.body);
 			printf(")");
+			break;
+
+		case VT_BUILTIN:
+			printf("<builtin>\n");
+			break;
 		default:
+			printf("<unknown>\n");
 	}
 
 	return val;
@@ -153,24 +177,25 @@ value *env_lookup(env *e, const char *sym) {
 }
 
 value *eval(env *e, value *v) {
-	value *found;
+	printf("evaluating: ");
+	print_value(v);
+	printf("\n");
 
 	if (v->type == VT_NIL) {
 		return v;
 	}
 
-	if (v->type == VT_SYMBOL &&
-		(found = env_lookup(e, v->as.sym))) {
-		return found;
+	if (v->type == VT_PAIR) {
+		return eval_pair(e, v);
 	}
 
 	if (v->type == VT_SYMBOL) {
-		printf("symbol %s not found\n", v->as.sym);
-		return v;
-	}
-
-	if (v->type == VT_PAIR) {
-		return eval_pair(e, v);
+		value *found = env_lookup(e, v->as.sym);
+		if (!found) {
+			printf("symbol %s not found\n", v->as.sym);
+			return make_nil();
+		}
+		return found;
 	}
 
 	return v;
@@ -180,13 +205,11 @@ value *eval_pair(env *e, value *v) {
 	value *head = car(v);
 	value *tail = cdr(v);
 
-	value *head_eval = eval(e, head);
-
-	if (head_eval->type == VT_LAMBDA) {
-		apply(head_eval, tail);
+	if (head->type == VT_SYMBOL && !strcmp(head->as.sym, "quote")) {
+		return car(tail);
 	}
 
-	if (!strcmp(head->as.str, "define")) {
+	if (head->type == VT_SYMBOL && !strcmp(head->as.sym, "define")) {
 		value *defargs = tail;
 		value *defname = car(defargs);
 		value *defval = eval(e, car(cdr(defargs)));
@@ -198,16 +221,37 @@ value *eval_pair(env *e, value *v) {
 			return v;
 		}
 		env_define(e, defname->as.sym, defval);
+		return defval;
 	}
 
-	if (!strcmp(head->as.str, "lambda") ||
-	    !strcmp(head->as.str, "\\") ||
-	    !strcmp(head->as.str, "λ")) {
+	if (head->type == VT_SYMBOL && (!strcmp(head->as.sym, "lambda") ||
+		!strcmp(head->as.sym, "\\") ||
+		!strcmp(head->as.sym, "λ"))) {
 		value *params = car(tail);
 		value *body = car(cdr(tail));
 
 		return make_lambda(e, params, body);
 	}
+
+	if (head->type == VT_SYMBOL && !strcmp(head->as.sym, "if")) {
+		value *test = eval(e, car(tail));
+		if(test->type != VT_NIL) {
+			return eval(e, car(cdr(tail)));
+		} else {
+			return eval(e, car(cdr(cdr(tail))));
+		}
+		return make_nil();
+	}
+
+	value *head_eval = eval(e, head);
+	if (head_eval->type == VT_BUILTIN) {
+		return head_eval->as.builtin.fn(e, tail);
+	}
+
+	if (head_eval->type == VT_LAMBDA) {
+		return apply(head_eval, tail);
+	}
+
 	return v;
 }
 
@@ -225,3 +269,122 @@ value *apply(value *lval, value *args) {
 	}
 	return eval(sub_env, lval->as.lambda.body);
 }
+
+value *builtin_cons(env *e, value *args) {
+	value *v = eval(e, car(args));
+	return cons(v, car(cdr(args)));
+}
+
+value *builtin_car(env *e, value *args) {
+	return car(eval(e, car(args)));
+}
+
+value *builtin_cdr(env *e, value *args) {
+	return cdr(eval(e, car(args)));
+}
+
+value *builtin_isnull(env *e, value *args) {
+	value *v = eval(e, car(args));
+	if(v->type == VT_NIL) {
+		return make_int(1);
+	}
+	return make_nil();
+}
+
+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: ");
+		print_value(v);
+		printf("\n");
+		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: ");
+			print_value(v);
+			printf("\n");
+			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 *builtin_add(env *e, value *args) {
+	return apply_to_nums(e, args, add_fn);
+}
+
+double sub_fn(double x, double y) { return x-y; }
+value *builtin_sub(env *e, value *args) {
+	return apply_to_nums(e, args, sub_fn);
+}
+
+double mul_fn(double x, double y) { return x*y; }
+value *builtin_mul(env *e, value *args) {
+	return apply_to_nums(e, args, mul_fn);
+}
+
+double div_fn(double x, double y) { return x/y; }
+value *builtin_div(env *e, value *args) {
+	return apply_to_nums(e, args, div_fn);
+}
+
+value *builtin_le(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: ");
+		print_value(v);
+		printf("\n");
+		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: ");
+			print_value(v);
+			printf("\n");
+			return make_nil();
+		}
+		if(prev_num > cur_num) {
+			return make_nil();
+		}
+		prev_num = cur_num;
+		args = cdr(args);
+	}
+	return make_int(1);
+}
+
+int is_integer(double x) {
+    return floor(x) == x && isfinite(x);
+}
diff --git a/lisp.h b/lisp.h
index a43f750..b7e5a94 100644
--- a/lisp.h
+++ b/lisp.h
@@ -11,7 +11,8 @@ typedef enum {
 	VT_STRING,
 	VT_NIL,
 	VT_PAIR,
-	VT_LAMBDA
+	VT_LAMBDA,
+	VT_BUILTIN
 } val_type;
 
 struct value {
@@ -30,6 +31,9 @@ struct value {
 			value *body;
 			env *env;
 		} lambda;
+		struct {
+			value *(*fn) (env *, value *);
+		} builtin;
 	} as;
 };
 
@@ -39,6 +43,7 @@ value *make_symbol(const char *sym);
 value *make_string(const char *str);
 value *make_nil();
 value *make_lambda(env *e, value *params, value *body);
+value *make_builtin(value *(*fn) (env *, value *));
 value *cons(value *car, value *cdr);
 value *car(value *cons);
 value *cdr(value *cons);
@@ -64,4 +69,16 @@ value *eval_pair(env *e, value *val);
 
 value *apply(value *lambda, value *args);
 
+value *builtin_cons(env *e, value *args);
+value *builtin_car(env *e, value *args);
+value *builtin_cdr(env *e, value *args);
+value *builtin_isnull(env *e, value *args);
+value *builtin_add(env *e, value *args);
+value *builtin_sub(env *e, value *args);
+value *builtin_mul(env *e, value *args);
+value *builtin_div(env *e, value *args);
+value *builtin_le(env *e, value *args);
+
+int is_integer(double x);
+
 #endif
diff --git a/lisp.l b/lisp.l
index 7a9eece..5ad5c57 100644
--- a/lisp.l
+++ b/lisp.l
@@ -7,14 +7,14 @@ int tcnt = 0;
 %}
 
 %%
-[[:space:]]+      { printf("%d: WHITESPACE\n", tcnt); /*ignore whitespace*/}
-"("             { printf("%d: LPAREN\n", ++tcnt); return LPAREN; }
-")"             { printf("%d: RPAREN\n", ++tcnt); return RPAREN; }
-"\."            { printf("%d: DOT\n", ++tcnt); return DOT; }
+[[:space:]]+      {  /*ignore whitespace*/}
+"("             {  return LPAREN; }
+")"             {  return RPAREN; }
+"\."            {  return DOT; }
 
 [+-]?([0-9]+|([0-9]*\.[0-9]+))([eE][-+]?[0-9]+)? {
                 yylval.dval = atof(yytext);
-                printf("%d: NUMBER: %f\n", ++tcnt, yylval.dval);
+                
                 return NUMBER;
                 }
 
@@ -27,13 +27,13 @@ int tcnt = 0;
                 str[len] = '\0';
 
                 yylval.strval = str;
-                printf("%d: STRING: \"%s\"\n", ++tcnt, yylval.strval);
+                
                 return STRING;
                 }
 
 [^[:space:]\"().]+ {
                 yylval.strval = strdup(yytext);
-                printf("%d: SYMBOL: %s\n", ++tcnt, yylval.strval);
+                
                 return SYMBOL;
                 }
 .               ; // do nothing 
diff --git a/lisp.y b/lisp.y
index 8ed479d..e8dd961 100644
--- a/lisp.y
+++ b/lisp.y
@@ -1,15 +1,10 @@
 %{
 #include <stdio.h>
 #include <stdlib.h>
-#include <math.h>
 #include "lisp.h"
 
 int yylex(void);
 int yyerror(const char *s);
-
-static int is_integer(double x) {
-    return floor(x) == x && isfinite(x);
-}
 %}
 
 %union {
diff --git a/main.c b/main.c
index c9f9acd..f297402 100644
--- a/main.c
+++ b/main.c
@@ -12,6 +12,15 @@ env *global_env = NULL;
 int main(void) {
 	// init global env
 	global_env = env_create(NULL);
+	env_define(global_env, "cons", make_builtin(builtin_cons));
+	env_define(global_env, "car", make_builtin(builtin_car));
+	env_define(global_env, "cdr", make_builtin(builtin_cdr));
+	env_define(global_env, "null?", make_builtin(builtin_isnull));
+	env_define(global_env, "+", make_builtin(builtin_add));
+	env_define(global_env, "-", make_builtin(builtin_sub));
+	env_define(global_env, "*", make_builtin(builtin_mul));
+	env_define(global_env, "/", make_builtin(builtin_div));
+	env_define(global_env, "<=", make_builtin(builtin_le));
 	// START REPL
 	char* line;
 	while ((line = readline("λ > ")) != NULL) {