klisp

commit a82abb4dcb78d08961369a5360b5cedaf14bc9c7
parent ebb89bf7beda53d0e564eed0b2741ffca28d192e
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 23 Mar 2011 03:44:15 -0300

Added string-ci<?, string-ci<=?, string-ci>? & string-ci>=? to the ground environment.

Diffstat:
M
src/kground.c
 | 
9
++++++++-
M
src/kgstrings.c
 | 
75
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
src/kgstrings.h
 | 
5
+++++

3 files changed, 88 insertions(+), 1 deletion(-)
diff --git a/src/kground.c b/src/kground.c
@@ -618,7 +618,14 @@ void kinit_ground_env(klisp_State *K)
 		    symbol, p2tv(kstringp), p2tv(kstring_gep));
 
     /* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
-    /* TODO */
+    add_applicative(K, ground_env, "string-ci<?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_ci_ltp));
+    add_applicative(K, ground_env, "string-ci<=?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_ci_lep));
+    add_applicative(K, ground_env, "string-ci>?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_ci_gtp));
+    add_applicative(K, ground_env, "string-ci>=?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_ci_gep));
 
     /* 13.2.5? substring */
     add_applicative(K, ground_env, "substring", substring, 0);
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -222,6 +222,81 @@ bool kstring_gep(TValue str1, TValue str2)
     return (res > 0 || (res == 0 && size2 <= size1));
 }
 
+bool kstring_ci_ltp(TValue str1, TValue str2)
+{
+    int32_t size1 = kstring_size(str1);
+    int32_t size2 = kstring_size(str2);
+    int32_t min_size = size1 < size2? size1 : size2;
+    char *buf1 = kstring_buf(str1);
+    char *buf2 = kstring_buf(str2);
+
+    while(min_size--) {
+	int diff = (int) tolower(*buf1) - (int) tolower(*buf2);
+	if (diff > 0)
+	    return false;
+	else if (diff < 0)
+	    return true;
+	buf1++, buf2++;
+    }
+    return size1 < size2;
+}
+
+bool kstring_ci_lep(TValue str1, TValue str2)
+{
+    int32_t size1 = kstring_size(str1);
+    int32_t size2 = kstring_size(str2);
+    int32_t min_size = size1 < size2? size1 : size2;
+    char *buf1 = kstring_buf(str1);
+    char *buf2 = kstring_buf(str2);
+
+    while(min_size--) {
+	int diff = (int) tolower(*buf1) - (int) tolower(*buf2);
+	if (diff > 0)
+	    return false;
+	else if (diff < 0)
+	    return true;
+	buf1++, buf2++;
+    }
+    return size1 <= size2;
+}
+
+bool kstring_ci_gtp(TValue str1, TValue str2)
+{
+    int32_t size1 = kstring_size(str1);
+    int32_t size2 = kstring_size(str2);
+    int32_t min_size = size1 < size2? size1 : size2;
+    char *buf1 = kstring_buf(str1);
+    char *buf2 = kstring_buf(str2);
+
+    while(min_size--) {
+	int diff = (int) tolower(*buf1) - (int) tolower(*buf2);
+	if (diff < 0)
+	    return false;
+	else if (diff > 0)
+	    return true;
+	buf1++, buf2++;
+    }
+    return size1 > size2;
+}
+
+bool kstring_ci_gep(TValue str1, TValue str2)
+{
+    int32_t size1 = kstring_size(str1);
+    int32_t size2 = kstring_size(str2);
+    int32_t min_size = size1 < size2? size1 : size2;
+    char *buf1 = kstring_buf(str1);
+    char *buf2 = kstring_buf(str2);
+
+    while(min_size--) {
+	int diff = (int) tolower(*buf1) - (int) tolower(*buf2);
+	if (diff < 0)
+	    return false;
+	else if (diff > 0)
+	    return true;
+	buf1++, buf2++;
+    }
+    return size1 >= size2;
+}
 
 /* 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
@@ -56,6 +56,11 @@ bool kstring_lep(TValue str1, TValue str2);
 bool kstring_gtp(TValue str1, TValue str2);
 bool kstring_gep(TValue str1, TValue str2);
 
+bool kstring_ci_ltp(TValue str1, TValue str2);
+bool kstring_ci_lep(TValue str1, TValue str2);
+bool kstring_ci_gtp(TValue str1, TValue str2);
+bool kstring_ci_gep(TValue str1, TValue str2);
+
 
 /* 13.2.5? substring */
 void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);