klisp

commit 67993f77957af75fe97c096a6e901cd70a0cf54b
parent a564f98345eda9cde8f8bcd2ca81b0262867ee8c
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 25 Mar 2011 12:54:34 -0300

Added assoc to the ground environment.

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

4 files changed, 27 insertions(+), 4 deletions(-)
diff --git a/src/Makefile b/src/Makefile
@@ -97,7 +97,7 @@ kgsymbols.o: kgsymbols.c kgsymbols.c kghelpers.h kstate.h klisp.h \
 kgcontrol.o: kgcontrol.c kgcontrol.c kghelpers.h kstate.h klisp.h \
 	kobject.h kerror.h kpair.h kcontinuation.h
 kgpairs_lists.o: kgpairs_lists.c kgpairs_lists.h kghelpers.h kstate.h klisp.h \
-	kobject.h kerror.h kpair.h ksymbol.h kcontinuation.h
+	kobject.h kerror.h kpair.h ksymbol.h kcontinuation.h kgequalp.h
 kgpair_mut.o: kgpair_mut.c kgpair_mut.h kghelpers.h kstate.h klisp.h \
 	kobject.h kerror.h kpair.h ksymbol.h kcontinuation.h kgeqp.h
 kgenvironments.o: kgenvironments.c kgenvironments.h kghelpers.h kstate.h \
diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -19,6 +19,7 @@
 #include "kerror.h"
 
 #include "kghelpers.h"
+#include "kgequalp.h"
 #include "kgpairs_lists.h"
 
 /* 4.6.1 pair? */
@@ -276,7 +277,29 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 /* TODO */
 
 /* 6.3.6 assoc */
-/* TODO */
+void assoc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+
+    bind_2p(K, "assoc", ptree, obj, ls);
+    /* first pass, check structure */
+    int32_t dummy;
+    int32_t pairs = check_typed_list(K, "assoc", "pair", kpairp,
+				     true, ls, &dummy);
+    TValue tail = ls;
+    TValue res = KNIL;
+    while(pairs--) {
+	TValue first = kcar(tail);
+	if (equal2p(K, kcar(first), obj)) {
+	    res = first;
+	    break;
+	}
+	tail = kcdr(tail);
+    }
+
+    kapply_cc(K, res);
+}
 
 /* 6.3.7 member? */
 /* TODO */
diff --git a/src/kgpairs_lists.h b/src/kgpairs_lists.h
@@ -70,7 +70,7 @@ void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 /* TODO */
 
 /* 6.3.6 assoc */
-/* TODO */
+void assoc(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 6.3.7 member? */
 /* TODO */
diff --git a/src/kground.c b/src/kground.c
@@ -393,7 +393,7 @@ void kinit_ground_env(klisp_State *K)
     /* TODO */
 
     /* 6.3.6 assoc */
-    /* TODO */
+    add_applicative(K, ground_env, "assoc", assoc, 0);
 
     /* 6.3.7 member? */
     /* TODO */