klisp

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

commit 36223ca843cfba80168da6feb5238fc933954552
parent 43a49653ae06132cc4570bd4c42dc186df6d2dd1
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 24 Mar 2011 17:34:33 -0300

Added list-ref to the ground environment.

Diffstat:
Msrc/kgpairs_lists.c | 35++++++++++++++++++++++++++++++++++-
Msrc/kgpairs_lists.h | 2+-
Msrc/kground.c | 2+-
3 files changed, 36 insertions(+), 3 deletions(-)

diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c @@ -231,7 +231,40 @@ void length(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) } /* 6.3.2 list-ref */ -/* TODO */ +void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) +{ +/* ASK John: can the object be an improper list? the wording of the report + seems to indicate that can't be the case, but it makes sense + (cf list-tail) For now we allow it. */ + (void) denv; + (void) xparams; + /* XXX: should be integer instead of fixint, but that's all + we have for now */ + bind_2tp(K, "list-ref", ptree, "any", anytype, obj, + "finite integer", ttisfixint, tk); + int k = ivalue(tk); + if (k < 0) { + klispE_throw(K, "list-ref: negative index"); + return; + } + + while(k) { + if (!ttispair(obj)) { + klispE_throw(K, "list-ref: non pair found while traversing " + "object"); + return; + } + obj = kcdr(obj); + --k; + } + if (!ttispair(obj)) { + klispE_throw(K, "list-ref: non pair found while traversing " + "object"); + return; + } + TValue res = kcar(obj); + kapply_cc(K, res); +} /* 6.3.3 append */ /* TODO */ diff --git a/src/kgpairs_lists.h b/src/kgpairs_lists.h @@ -58,7 +58,7 @@ void list_tail(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); void length(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); /* 6.3.2 list-ref */ -/* TODO */ +void list_ref(klisp_State *K, TValue *xparams, TValue ptree, TValue denv); /* 6.3.3 append */ /* TODO */ diff --git a/src/kground.c b/src/kground.c @@ -379,7 +379,7 @@ void kinit_ground_env(klisp_State *K) add_applicative(K, ground_env, "length", length, 0); /* 6.3.2 list-ref */ - /* TODO */ + add_applicative(K, ground_env, "list-ref", list_ref, 0); /* 6.3.3 append */ /* TODO */