klisp

commit 9fecc796d2aff85ae94a1adaff343556fd5738d7
parent 67993f77957af75fe97c096a6e901cd70a0cf54b
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 25 Mar 2011 12:59:14 -0300

Added member? to the ground environment. Corrected name string in memq?.

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

4 files changed, 25 insertions(+), 4 deletions(-)
diff --git a/src/kgpair_mut.c b/src/kgpair_mut.c
@@ -259,7 +259,7 @@ void memqp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     UNUSED(xparams);
     UNUSED(denv);
 
-    bind_2p(K, "memq", ptree, obj, ls);
+    bind_2p(K, "memq?", ptree, obj, ls);
     /* first pass, check structure */
     int32_t dummy;
     int32_t pairs = check_list(K, "memq?", true, ls, &dummy);
diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -302,7 +302,28 @@ void assoc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 }
 
 /* 6.3.7 member? */
-/* TODO */
+void memberp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_2p(K, "member?", ptree, obj, ls);
+    /* first pass, check structure */
+    int32_t dummy;
+    int32_t pairs = check_list(K, "member?", true, ls, &dummy);
+    TValue tail = ls;
+    TValue res = KFALSE;
+    while(pairs--) {
+	TValue first = kcar(tail);
+	if (equal2p(K, first, obj)) {
+	    res = KTRUE;
+	    break;
+	}
+	tail = kcdr(tail);
+    }
+
+    kapply_cc(K, res);
+}
 
 /* 6.3.8 finite-list? */
 /* NOTE: can't use ftypep because the predicate marks pairs too */
diff --git a/src/kgpairs_lists.h b/src/kgpairs_lists.h
@@ -73,7 +73,7 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void assoc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 6.3.7 member? */
-/* TODO */
+void memberp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 6.3.8 finite-list? */
 void finite_listp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
diff --git a/src/kground.c b/src/kground.c
@@ -396,7 +396,7 @@ void kinit_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "assoc", assoc, 0);
 
     /* 6.3.7 member? */
-    /* TODO */
+    add_applicative(K, ground_env, "member?", memberp, 0);
 
     /* 6.3.8 finite-list? */
     add_applicative(K, ground_env, "finite-list?", finite_listp, 0);