klisp

commit 5ec015823547ac323080a0f66fbaa2793f742b7e
parent 90ee297ab888cd8b43860e8589bea55f7a0e4210
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 24 Mar 2011 16:20:01 -0300

Added or? the the ground environment.

Diffstat:
M
src/kgbooleans.c
 | 
22
++++++++++++++++++++--
M
src/kgbooleans.h
 | 
2
+-
M
src/kground.c
 | 
2
+-

3 files changed, 22 insertions(+), 4 deletions(-)
diff --git a/src/kgbooleans.c b/src/kgbooleans.c
@@ -42,7 +42,7 @@ void andp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
     UNUSED(xparams);
     UNUSED(denv);
     int32_t dummy; /* don't care about cycle pairs */
-    int32_t pairs = check_typed_list(K, "andp", "boolean", kbooleanp,
+    int32_t pairs = check_typed_list(K, "and?", "boolean", kbooleanp,
 				     true, ptree, &dummy);
     TValue res = KTRUE;
     TValue tail = ptree;
@@ -58,7 +58,25 @@ void andp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 }
 
 /* 6.1.3 or? */
-/* TODO */
+void orp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
+{
+    UNUSED(xparams);
+    UNUSED(denv);
+    int32_t dummy; /* don't care about cycle pairs */
+    int32_t pairs = check_typed_list(K, "or?", "boolean", kbooleanp,
+				     true, ptree, &dummy);
+    TValue res = KFALSE;
+    TValue tail = ptree;
+    while(pairs--) {
+	TValue first = kcar(tail);
+	tail = kcdr(tail);
+	if (kis_true(first)) {
+	    res = KTRUE;
+	    break;
+	}
+    }
+    kapply_cc(K, res);
+}
 
 /* 6.1.4 $and? */
 /* TODO */
diff --git a/src/kgbooleans.h b/src/kgbooleans.h
@@ -28,7 +28,7 @@ void notp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void andp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 6.1.3 or? */
-/* TODO */
+void orp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 6.1.4 $and? */
 /* TODO */
diff --git a/src/kground.c b/src/kground.c
@@ -355,7 +355,7 @@ void kinit_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "and?", andp, 0);
 
     /* 6.1.3 or? */
-    /* TODO */
+    add_applicative(K, ground_env, "or?", orp, 0);
 
     /* 6.1.4 $and? */
     /* TODO */