klisp

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

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

Diffstat:
M
src/kground.c
 | 
9
++++++++-
M
src/kgstrings.c
 | 
48
++++++++++++++++++++++++++++++++++++++++++++++++
M
src/kgstrings.h
 | 
6
++++++

3 files changed, 62 insertions(+), 1 deletion(-)
diff --git a/src/kground.c b/src/kground.c
@@ -608,7 +608,14 @@ void kinit_ground_env(klisp_State *K)
 		    symbol, p2tv(kstringp), p2tv(kstring_ci_eqp));
 
     /* 13.2.3? string<?, string<=?, string>?, string>=? */
-    /* TODO */
+    add_applicative(K, ground_env, "string<?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_ltp));
+    add_applicative(K, ground_env, "string<=?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_lep));
+    add_applicative(K, ground_env, "string>?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_gtp));
+    add_applicative(K, ground_env, "string>=?", ftyped_bpredp, 3,
+		    symbol, p2tv(kstringp), p2tv(kstring_gep));
 
     /* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */
     /* TODO */
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -174,6 +174,54 @@ bool kstring_ci_eqp(TValue str1, TValue str2)
     }
 }
 
+bool kstring_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;
+    /* memcmp > 0 if str1 has a bigger char in first diff position */
+    int res = memcmp(kstring_buf(str1), kstring_buf(str2), min_size);
+
+    return (res < 0 || (res == 0 && size1 < size2));
+}
+
+bool kstring_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;
+    /* memcmp > 0 if str1 has a bigger char in first diff position */
+    int res = memcmp(kstring_buf(str1), kstring_buf(str2), min_size);
+
+    return (res < 0 || (res == 0 && size1 <= size2));
+}
+
+bool kstring_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;
+    /* memcmp > 0 if str1 has a bigger char in first diff position */
+    int res = memcmp(kstring_buf(str1), kstring_buf(str2), min_size);
+
+    return (res > 0 || (res == 0 && size2 < size1));
+}
+
+bool kstring_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;
+    /* memcmp > 0 if str1 has a bigger char in first diff position */
+    int res = memcmp(kstring_buf(str1), kstring_buf(str2), min_size);
+
+    return (res > 0 || (res == 0 && size2 <= size1));
+}
+
 
 /* 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
@@ -51,6 +51,12 @@ void string(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);
 bool kstring_eqp(TValue str1, TValue str2);
 bool kstring_ci_eqp(TValue str1, TValue str2);
 
+bool kstring_ltp(TValue str1, TValue str2);
+bool kstring_lep(TValue str1, TValue str2);
+bool kstring_gtp(TValue str1, TValue str2);
+bool kstring_gep(TValue str1, TValue str2);
+
+
 /* 13.2.5? substring */
 void substring(klisp_State *K, TValue *xparams, TValue ptree, TValue denv);