klisp

commit d142d111a8b00b69c626f4d28bc53358efae0c7f
parent 40cd70f9f7d085a4128ecbcff3e58cf897e8a900
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Tue, 22 Mar 2011 12:17:16 -0300

Added extra output parameter to check_typed_list to return the numbers of pairs in the cycle.

Diffstat:
M
src/kghelpers.c
 | 
9
+++++----
M
src/kghelpers.h
 | 
4
++--
M
src/kgnumbers.c
 | 
10
+++++++---

3 files changed, 14 insertions(+), 9 deletions(-)
diff --git a/src/kghelpers.c b/src/kghelpers.c
@@ -201,19 +201,20 @@ void ftyped_bpredp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 
 /* typed finite list. Structure error should be throw before type errors */
 int32_t check_typed_list(klisp_State *K, char *name, char *typename,
-			 bool (*typep)(TValue), bool allow_infp, TValue obj)
+			 bool (*typep)(TValue), bool allow_infp, TValue obj,
+			 int32_t *cpairs)
 {
     TValue tail = obj;
-    int pairs = 0;
+    int32_t pairs = 0;
     bool type_errorp = false;
-
     while(ttispair(tail) && !kis_marked(tail)) {
 	/* even if there is a type error continue checking the structure */
 	type_errorp |= !(*typep)(kcar(tail));
-	kmark(tail);
+	kset_mark(tail, i2tv(pairs));
 	tail = kcdr(tail);
 	++pairs;
     }
+    *cpairs = ttispair(tail)? (pairs - ivalue(kget_mark(tail))) : 0;
     unmark_list(K, obj);
 
     if (!ttispair(tail) && !ttisnil(tail)) {
diff --git a/src/kghelpers.h b/src/kghelpers.h
@@ -235,8 +235,8 @@ inline void unmark_tree(klisp_State *K, TValue obj)
 
 /* typed finite list. Structure error should be throw before type errors */
 int32_t check_typed_list(klisp_State *K, char *name, char *typename,
-			 bool (*typep)(TValue), bool allow_infp, TValue obj);
-
+			 bool (*typep)(TValue), bool allow_infp, TValue obj,
+			 int32_t *cpairs);
 
 /*
 ** MAYBE: These shouldn't be inline really.
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -377,7 +377,9 @@ void kmin_max(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     bool minp = bvalue(xparams[1]);
 
     /* cycles are allowed, loop counting pairs */
-    int32_t pairs = check_typed_list(K, name, "number", knumberp, true, ptree);
+    int32_t dummy; /* don't care about count of cycle pairs */
+    int32_t pairs = check_typed_list(K, name, "number", knumberp, true, ptree,
+	&dummy);
     
     TValue res;
     bool one_finite = false;
@@ -462,8 +464,9 @@ void kgcd(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     UNUSED(xparams);
     UNUSED(denv);
     /* cycles are allowed, loop counting pairs */
+    int32_t dummy; /* don't care about count of cycle pairs */
     int32_t pairs = check_typed_list(K, "gcd", "number", knumberp, true,
-				     ptree);
+				     ptree, &dummy);
 
     TValue res;
 
@@ -503,8 +506,9 @@ void klcm(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     UNUSED(xparams);
     UNUSED(denv);
     /* cycles are allowed, loop counting pairs */
+    int32_t dummy; /* don't care about count of cycle pairs */
     int32_t pairs = check_typed_list(K, "lcm", "number", knumberp, true, 
-				     ptree);
+				     ptree, &dummy);
     /* we will need to loop again after obtaining the gcd */
     int32_t saved_pairs = pairs;