klisp

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:
M
src/kgpairs_lists.c
 | 
35
++++++++++++++++++++++++++++++++++-
M
src/kgpairs_lists.h
 | 
2
+-
M
src/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 */