klisp

commit d39ed8fe1e0e487000b793bfe324988d1c1747ae
parent da488957c16e1aa47c6302e3ea902ccdda09ede3
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 18 Mar 2011 17:17:50 -0300

Bugfix: added type check to ftyped_predp when there was only one argument.

Diffstat:
M
src/kghelpers.c
 | 
30
++++++++++++++++++++++--------

1 file changed, 22 insertions(+), 8 deletions(-)
diff --git a/src/kghelpers.c b/src/kghelpers.c
@@ -169,18 +169,32 @@ void ftyped_bpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     /* check the type while checking the predicate.
        Keep going even if the result is false to catch errors in 
        type */
-    /* it checks > 0 because if ptree is nil comps = -1 */
-    while(comps-- > 0) {
-	TValue first = kcar(tail);
-	tail = kcdr(tail); /* tail only advances one place per iteration */
-	TValue second = kcar(tail);
 
-	if (!(*typep)(first) && !(*typep)(second)) {
+    if (comps == -1) {
+	/* this case is here to simplify the guard of the while */
+	kapply_cc(K, b2tv(true));
+    } else if (comps == 0) {
+	/* this case has to be here because otherwise there is no check
+	   for the type of the lone operand */
+	TValue first = kcar(tail);
+	if (!(*typep)(first)) {
 	    /* TODO show expected type */
 	    klispE_throw_extra(K, name, ": bad argument type");
 	    return;
 	}
-	res &= (*predp)(first, second);
+    } else {
+	while(comps--) {
+	    TValue first = kcar(tail);
+	    tail = kcdr(tail); /* tail only advances one place per iteration */
+	    TValue second = kcar(tail);
+
+	    if (!(*typep)(first) && !(*typep)(second)) {
+		/* TODO show expected type */
+		klispE_throw_extra(K, name, ": bad argument type");
+		return;
+	    }
+	    res &= (*predp)(first, second);
+	}
+	kapply_cc(K, b2tv(res));
     }
-    kapply_cc(K, b2tv(res));
 }