* eval.c (eval_init): lazy string related functions become intrinsics.

* lib.c (string_cmp): New function.

* lib.h (TYPE_SHIFT, TYPE_PAIR): New macros.
(string_cmp): Declared.

4 files changed, 60 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index 2c37d00a..c88927bf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1834,6 +1834,15 @@
 
 2012-03-18  Kaz Kylheku  <kaz@kylheku.com>
 
+	* eval.c (eval_init): lazy string related functions become intrinsics.
+
+	* lib.c (string_cmp): New function.
+
+	* lib.h (TYPE_SHIFT, TYPE_PAIR): New macros.
+	(string_cmp): Declared.
+ 
+2012-03-18  Kaz Kylheku  <kaz@kylheku.com>
+
 	* eval.c (eval_init): url_decode has two parameters now,
 	so we make the second one optional.
 
diff --git a/eval.c b/eval.c
index 64f8de49..501a20a0 100644
--- a/eval.c
+++ b/eval.c
@@ -2400,6 +2400,16 @@ void eval_init(void)
   reg_fun(intern(lit("compl-span-str"), user_package), func_n2(compl_span_str));
   reg_fun(intern(lit("break-str"), user_package), func_n2(break_str));
 
+  reg_fun(intern(lit("lazy-stream-cons"), user_package), func_n1(lazy_stream_cons));
+  reg_fun(intern(lit("lazy-str"), user_package), func_n3(lazy_str));
+  reg_fun(intern(lit("lazy-str-force-upto"), user_package), func_n2(lazy_str_force_upto));
+  reg_fun(intern(lit("lazy-str-force"), user_package), func_n1(lazy_str_force));
+  reg_fun(intern(lit("lazy-str-get-trailing-list"), user_package), func_n2(lazy_str_get_trailing_list));
+  reg_fun(intern(lit("length-str-gt"), user_package), func_n2(length_str_gt));
+  reg_fun(intern(lit("length-str-ge"), user_package), func_n2(length_str_ge));
+  reg_fun(intern(lit("length-str-lt"), user_package), func_n2(length_str_lt));
+  reg_fun(intern(lit("length-str-le"), user_package), func_n2(length_str_le));
+
   reg_fun(intern(lit("vector"), user_package), func_n1(vector));
   reg_fun(intern(lit("vectorp"), user_package), func_n1(vectorp));
   reg_fun(intern(lit("vec-set-length"), user_package), func_n2(vec_set_length));
diff --git a/lib.c b/lib.c
index a1e505c8..d5f5dd32 100644
--- a/lib.c
+++ b/lib.c
@@ -2116,6 +2116,45 @@ val trim_str(val str)
   }
 }
 
+val string_cmp(val astr, val bstr)
+{
+   switch (TYPE_PAIR(tag(astr), tag(bstr))) {
+   case TYPE_PAIR(LIT, LIT):
+   case TYPE_PAIR(STR, STR):
+   case TYPE_PAIR(LIT, STR):
+   case TYPE_PAIR(STR, LIT):
+     return num_fast(wcscmp(c_str(astr), c_str(bstr)));
+   case TYPE_PAIR(LSTR, LIT):
+   case TYPE_PAIR(LSTR, STR):
+   case TYPE_PAIR(LIT, LSTR):
+   case TYPE_PAIR(STR, LSTR):
+   case TYPE_PAIR(LSTR, LSTR):
+     {
+       val i;
+       for (i = zero;
+            length_str_lt(astr, i) && length_str_lt(bstr, i);
+            i = plus(i, one))
+       {
+         val ach = chr_str(astr, i);
+         val bch = chr_str(bstr, i);
+
+         if (ach < bch)
+           return num_fast(-1);
+         else if (ach < bch)
+           return num_fast(1);
+       }
+       if (length_str_lt(bstr, i))
+         return num_fast(-1);
+       if (length_str_lt(astr, i))
+         return num_fast(1);
+       return zero;
+     }
+   default:
+     uw_throwf(error_s, lit("string-cmp: invalid operands ~s ~s"),
+               astr, bstr, nao);
+  }
+}
+
 val string_lt(val astr, val bstr)
 {
   return wcscmp(c_str(astr), c_str(bstr)) < 0 ? t : nil;
diff --git a/lib.h b/lib.h
index 5cecbad1..2b87e7c8 100644
--- a/lib.h
+++ b/lib.h
@@ -42,7 +42,7 @@ typedef int_ptr_t cnum;
 typedef enum type {
   NIL, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS,
   STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, ENV,
-  BGNUM, FLNUM
+  BGNUM, FLNUM /* If extending, check TYPE_SHIFT */
 } type_t;
 
 #define TYPE_SHIFT 4
@@ -504,6 +504,7 @@ val split_str_set(val str, val set);
 val tok_str(val str, val tok_regex);
 val list_str(val str);
 val trim_str(val str);
+val string_cmp(val astr, val bstr);
 val string_lt(val astr, val bstr);
 val int_str(val str, val base);
 val flo_str(val str);