klisp

commit 2e2fc9c3749200b8d92630bc477575cdf9603371
parent c5bfb6985d3c25035fd41d50aedf6eae799f3682
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Mar 2011 03:24:46 -0300

Added string=? and string-ci=? to the ground environment.

Diffstat:
M
src/kground.c
 | 
5
++++-
M
src/kgstrings.c
 | 
37
++++++++++++++++++++++++++++++++++---
M
src/kgstrings.h
 | 
11
++++++++---

3 files changed, 46 insertions(+), 7 deletions(-)
diff --git a/src/kground.c b/src/kground.c
@@ -602,7 +602,10 @@ void kinit_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "string", string, 0);
 
     /* 13.2.2? string=?, string-ci=? */
-    /* TODO */
+    add_applicative(K, ground_env, "string=?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_eqp));
+    add_applicative(K, ground_env, "string-ci=?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_ci_eqp));
 
     /* 13.2.3? string<?, string<=?, string>?, string>=? */
     /* TODO */
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -136,13 +136,44 @@ void string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
 }
 
 /* 13.2.2? string=?, string-ci=? */
-/* TODO */
+/* use ftyped_bpredp */
 
 /* 13.2.3? string<?, string<=?, string>?, string>=? */
-/* TODO */
+/* use ftyped_bpredp */
 
 /* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
-/* TODO */
+/* use ftyped_bpredp */
+
+/* Helpers for binary predicates */
+/* XXX: this should probably be in file kstring.h */
+bool kstring_eqp(TValue str1, TValue str2)
+{
+    int32_t size = kstring_size(str1);
+    if (kstring_size(str2) != size)
+	return false;
+    else
+	return ((size == 0) || 
+		memcmp(kstring_buf(str1), kstring_buf(str2), size) == 0);
+}
+
+bool kstring_ci_eqp(TValue str1, TValue str2)
+{
+    int32_t size = kstring_size(str1);
+    if (kstring_size(str2) != size)
+	return false;
+    else {
+	char *buf1 = kstring_buf(str1);
+	char *buf2 = kstring_buf(str2);
+
+	while(size--) {
+	    if (tolower(*buf1) != tolower(*buf2))
+		return false;
+	    buf1++, buf2++;
+	}
+	return true;
+    }
+}
+
 
 /* 13.2.5? substring */
 void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv)
diff --git a/src/kgstrings.h b/src/kgstrings.h
@@ -38,13 +38,18 @@ void string_setS (klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 void string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 
 /* 13.2.2? string=?, string-ci=? */
-/* TODO */
+/* use ftyped_bpredp */
 
 /* 13.2.3? string<?, string<=?, string>?, string>=? */
-/* TODO */
+/* use ftyped_bpredp */
 
 /* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
-/* TODO */
+/* use ftyped_bpredp */
+
+/* Helpers for binary predicates */
+/* XXX: this should probably be in file kstring.h */
+bool kstring_eqp(TValue str1, TValue str2);
+bool kstring_ci_eqp(TValue str1, TValue str2);
 
 /* 13.2.5? substring */
 void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);