klisp

commit 04c8ff469bb0d7de4eded9a9b8c587395519970d
parent ae42742188a161967abef7a674d3a7466beea015
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 24 Mar 2011 18:51:26 -0300

Added countable-list? to the ground environment.

Diffstat:
M
src/kgpairs_lists.c
 | 
32
++++++++++++++++++++++++++++++--
M
src/kgpairs_lists.h
 | 
3
++-
M
src/kground.c
 | 
2
+-

3 files changed, 33 insertions(+), 4 deletions(-)
diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -282,12 +282,13 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 /* TODO */
 
 /* 6.3.8 finite-list? */
+/* NOTE: can't use ftypep because the predicate marks pairs too */
 void finite_listp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 {
     UNUSED(xparams);
     UNUSED(denv);
 
-    int32_t pairs = check_list(K, "finite-list", ptree);
+    int32_t pairs = check_list(K, "finite-list?", ptree);
 
     TValue res = KTRUE;
     TValue tail = ptree;
@@ -310,7 +311,34 @@ void finite_listp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 }
 
 /* 6.3.9 countable-list? */
-/* TODO */
+/* NOTE: can't use ftypep because the predicate marks pairs too */
+void countable_listp(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    int32_t pairs = check_list(K, "countable-list?", ptree);
+
+    TValue res = KTRUE;
+    TValue tail = ptree;
+    while(pairs--) {
+	TValue first = kcar(tail);
+	tail = kcdr(tail);
+	TValue itail = first;
+	while(ttispair(itail) && !kis_marked(itail)) {
+	    kmark(itail);
+	    itail = kcdr(itail);
+	}
+	unmark_list(K, first);
+	
+	if (!ttisnil(itail) && !ttispair(itail)) {
+	    res = KFALSE;
+	    break;
+	}
+    }
+    kapply_cc(K, res);
+}
 
 /* 6.3.10 reduce */
 /* TODO */
diff --git a/src/kgpairs_lists.h b/src/kgpairs_lists.h
@@ -79,7 +79,8 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void finite_listp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 6.3.9 countable-list? */
-/* TODO */
+void countable_listp(klisp_State *K, TValue *xparams, TValue ptree, 
+		    TValue denv);
 
 /* 6.3.10 reduce */
 /* TODO */
diff --git a/src/kground.c b/src/kground.c
@@ -400,7 +400,7 @@ void kinit_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "finite-list?", finite_listp, 0);
 
     /* 6.3.9 countable-list? */
-    /* TODO */
+    add_applicative(K, ground_env, "countable-list?", countable_listp, 0);
 
     /* 6.3.10 reduce */
     /* TODO */