From: Elijah Cohen <cohen@eli173.com>
Date: Tue, 15 Oct 2024 21:00:21 +0000 (+0000)
Subject: added minimal typechecking to builtins
X-Git-Url: https://git.eli173.com/?a=commitdiff_plain;h=a60c248cdf1efe4137862a5337114aa751c0993e;p=klapaucius

added minimal typechecking to builtins
---

diff --git a/src/Makefile b/src/Makefile
index ff4cd89..1211867 100644
--- 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 c4692ee..ea9ab88 100644
--- 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 084229f..b365e6b 100644
--- 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 2cc3fd2..e839ce1 100644
--- 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)");
+	
 }