klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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:
Msrc/Makefile | 2+-
Msrc/kgpairs_lists.c | 25++++++++++++++++++++++++-
Msrc/kgpairs_lists.h | 2+-
Msrc/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 */