added minimal typechecking to builtins

diff --git a/src/Makefile b/src/Makefile
index ff4cd89edb19053ac018da04886c5a0f369f5bfc..1211867caf73f5110294899ccdc86d19ea55b38e 100644 (file)
--- a/src/Makefile
+++ b/src/Makefile
@@ -18,7 +18,7 @@ TEST_OBJS:= $(filter-out $(BUILD)/repl.o,$(OBJS))
 
 LIBRARIES = libedit
 
-CFLAGS:= -g -Wall `pkg-config $(LIBRARIES) --cflags`
+CFLAGS:= -g -Wall `pkg-config $(LIBRARIES) --cflags` -DTYPECHECK
 LDFLAGS:= -g -Wall `pkg-config $(LIBRARIES) --libs`
 
 

diff --git a/src/builtins/arithmetic.c b/src/builtins/arithmetic.c
index c4692ee75969234239aad8a2c26313b58381553a..ea9ab886b85285be370d9f2d39a464ca124c8ebe 100644 (file)
--- a/src/builtins/arithmetic.c
+++ b/src/builtins/arithmetic.c
@@ -18,6 +18,15 @@ Sexpr* a_plus(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* args = b->value.b.args;
        Sexpr* i = eval(clone(car(args)), env);
        Sexpr* j = eval(clone(car(cdr(args))), env);
+#ifdef TYPECHECK
+       if((unquote(i)->type != UINT) || (unquote(j)->type != UINT)) {
+               ERR("+: ", "arguments not uints");
+               sexpr_free(b);
+               sexpr_free(i);
+               sexpr_free(j);
+               return cons(from_nil(), rest);
+       }
+#endif // typecheck
        K_UINT_TYPE m = unquote(i)->value.u;
        K_UINT_TYPE n = unquote(j)->value.u;
        sexpr_free(b);
@@ -33,6 +42,15 @@ Sexpr* a_minus(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* args = b->value.b.args;
        Sexpr* i = eval(clone(car(args)), env);
        Sexpr* j = eval(clone(car(cdr(args))), env);
+#ifdef TYPECHECK
+       if((unquote(i)->type != UINT) || (unquote(j)->type != UINT)) {
+               ERR("-: ", "arguments not uints");
+               sexpr_free(b);
+               sexpr_free(i);
+               sexpr_free(j);
+               return cons(from_nil(), rest);
+       }
+#endif // typecheck
        K_UINT_TYPE m = unquote(i)->value.u;
        K_UINT_TYPE n = unquote(j)->value.u;
        sexpr_free(b);
@@ -48,6 +66,15 @@ Sexpr* a_mul(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* args = b->value.b.args;
        Sexpr* i = eval(clone(car(args)), env);
        Sexpr* j = eval(clone(car(cdr(args))), env);
+#ifdef TYPECHECK
+       if((unquote(i)->type != UINT) || (unquote(j)->type != UINT)) {
+               ERR("*: ", "arguments not uints");
+               sexpr_free(b);
+               sexpr_free(i);
+               sexpr_free(j);
+               return cons(from_nil(), rest);
+       }
+#endif // typecheck
        K_UINT_TYPE m = unquote(i)->value.u;
        K_UINT_TYPE n = unquote(j)->value.u;
        sexpr_free(b);
@@ -63,6 +90,15 @@ Sexpr* a_div(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* args = b->value.b.args;
        Sexpr* i = eval(clone(car(args)), env);
        Sexpr* j = eval(clone(car(cdr(args))), env);
+#ifdef TYPECHECK
+       if((unquote(i)->type != UINT) || (unquote(j)->type != UINT)) {
+               ERR("/: ", "arguments not uints");
+               sexpr_free(b);
+               sexpr_free(i);
+               sexpr_free(j);
+               return cons(from_nil(), rest);
+       }
+#endif // typecheck
        K_UINT_TYPE m = unquote(i)->value.u;
        K_UINT_TYPE n = unquote(j)->value.u;
        sexpr_free(b);
@@ -78,6 +114,15 @@ Sexpr* a_mod(Sexpr* b, Sexpr* rest, Sexpr* env) {
        Sexpr* args = b->value.b.args;
        Sexpr* i = eval(clone(car(args)), env);
        Sexpr* j = eval(clone(car(cdr(args))), env);
+#ifdef TYPECHECK
+       if((unquote(i)->type != UINT) || (unquote(j)->type != UINT)) {
+               ERR("%: ", "arguments not uints");
+               sexpr_free(b);
+               sexpr_free(i);
+               sexpr_free(j);
+               return cons(from_nil(), rest);
+       }
+#endif // typecheck
        K_UINT_TYPE m = unquote(i)->value.u;
        K_UINT_TYPE n = unquote(j)->value.u;
        sexpr_free(b);

diff --git a/src/builtins/core.c b/src/builtins/core.c
index 084229f368c0e9a2518723e2c14e29c3653403bf..b365e6b308ab8db9745b81ef4d0aeffac0ed3aab 100644 (file)
--- a/src/builtins/core.c
+++ b/src/builtins/core.c
@@ -45,6 +45,14 @@ Sexpr* c_car(Sexpr* b, Sexpr* rest, Sexpr* env) {
                return cons(b, rest);
        Sexpr* args = b->value.b.args;
        Sexpr* unqargev = eval(clone(car(args)), env);
+#ifdef TYPECHECK
+       if(unquote(unqargev)->type != CONS) {
+               ERR("car: ", "argument not cons cell");
+               sexpr_free(b);
+               sexpr_free(unqargev);
+               return cons(from_nil(), rest);
+       }
+#endif // typecheck
        Sexpr* ret = cons(from_quote(clone(car(unquote(unqargev)))), rest);
        sexpr_free(unqargev);
        sexpr_free(b);
@@ -55,6 +63,14 @@ Sexpr* c_cdr(Sexpr* b, Sexpr* rest, Sexpr* env) {
                return cons(b, rest);
        Sexpr* args = b->value.b.args;
        Sexpr* unqargev = eval(clone(car(args)), env);
+#ifdef TYPECHECK
+       if(unquote(unqargev)->type != CONS) {
+               ERR("cdr: ", "argument not cons cell");
+               sexpr_free(b);
+               sexpr_free(unqargev);
+               return cons(from_nil(), rest);
+       }
+#endif // typecheck
        Sexpr* ret = cons(from_quote(clone(cdr(unquote(unqargev)))), rest);
        sexpr_free(unqargev);
        sexpr_free(b);

diff --git a/src/test.c b/src/test.c
index 2cc3fd229c9267f6e578d548dff240accefc9d02..e839ce156bd8a088e40765709a0d99c815d5bd1d 100644 (file)
--- a/src/test.c
+++ b/src/test.c
@@ -307,6 +307,12 @@ void eval_tests() {
        run_eval_test("(t 4 5)");
        run_eval_test("(nil 4 5)");
        run_eval_test("(5 (+ 3) 4)");
+
+       run_eval_test("(Z (B B S (C (eq 0) 1) (B B S * (C B (C - 1)))) 6)");
+
+       run_eval_test("(+ 5 (* 5))");
+       run_eval_test("(car 5)");
+       
 }