klisp

commit ae42742188a161967abef7a674d3a7466beea015
parent 36223ca843cfba80168da6feb5238fc933954552
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 24 Mar 2011 18:46:32 -0300

Added finite-list? to the ground environment.

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

3 files changed, 28 insertions(+), 3 deletions(-)
diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -282,7 +282,32 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 /* TODO */
 
 /* 6.3.8 finite-list? */
-/* TODO */
+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);
+
+    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)) {
+	    res = KFALSE;
+	    break;
+	}
+    }
+    kapply_cc(K, res);
+}
 
 /* 6.3.9 countable-list? */
 /* TODO */
diff --git a/src/kgpairs_lists.h b/src/kgpairs_lists.h
@@ -76,7 +76,7 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 /* TODO */
 
 /* 6.3.8 finite-list? */
-/* TODO */
+void finite_listp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 6.3.9 countable-list? */
 /* TODO */
diff --git a/src/kground.c b/src/kground.c
@@ -397,7 +397,7 @@ void kinit_ground_env(klisp_State *K)
     /* TODO */
 
     /* 6.3.8 finite-list? */
-    /* TODO */
+    add_applicative(K, ground_env, "finite-list?", finite_listp, 0);
 
     /* 6.3.9 countable-list? */
     /* TODO */