* arith.c (plus, minus, gt, lt, ge, le): Handle character operands.

* eval.c (eval_init): New functions interned.

* lib.c (num_chr, chr_num): New functions.

* lib.h (num_chr, chr_num): Declared.

* txr.1: Documentation stubs.

6 files changed, 88 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 5241c4c1..d2bc23b1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2011-12-14  Kaz Kylheku  <kaz@kylheku.com>
+
+	* arith.c (plus, minus, gt, lt, ge, le): Handle character operands.
+
+	* eval.c (eval_init): New functions interned.
+
+	* lib.c (num_chr, chr_num): New functions.
+
+	* lib.h (num_chr, chr_num): Declared.
+
+	* txr.1: Documentation stubs.
+
 2011-12-13  Kaz Kylheku  <kaz@kylheku.com>
 
 	Version 048
diff --git a/arith.c b/arith.c
index f222617d..79fb26d0 100644
--- a/arith.c
+++ b/arith.c
@@ -324,8 +324,32 @@ val plus(val anum, val bnum)
       mp_add(mp(anum), mp(bnum), mp(n));
       return normalize(n);
     }
+  case TAG_PAIR(TAG_CHR, TAG_NUM):
+    {
+      wchar_t a = c_chr(anum);
+      cnum b = c_num(bnum);
+      cnum sum = a + b;
+
+      if (sum < 0 || sum > 0x10FFFF)
+        goto char_range;
+      return chr(sum);
+    }
+  case TAG_PAIR(TAG_NUM, TAG_CHR):
+    {
+      cnum a = c_chr(anum);
+      wchar_t b = c_num(bnum);
+      cnum sum = a + b;
+
+      if (sum < 0 || sum > 0x10FFFF)
+        goto char_range;
+      return chr(sum);
+    }
   }
   uw_throwf(error_s, lit("plus: invalid operands ~s ~s"), anum, bnum, nao);
+char_range:
+  uw_throwf(numeric_error_s, 
+            lit("plus: sum of ~s ~s is out of character range"),
+            anum, bnum, nao);
   abort();
 }
 
@@ -397,6 +421,18 @@ val minus(val anum, val bnum)
       mp_sub(mp(anum), mp(bnum), mp(n));
       return normalize(n);
     }
+  case TAG_PAIR(TAG_CHR, TAG_NUM):
+    {
+      wchar_t a = c_chr(anum);
+      cnum b = c_num(bnum);
+      cnum sum = a - b;
+
+      if (sum < 0 || sum > 0x10FFFF)
+        uw_throwf(numeric_error_s, 
+                  lit("minus: sum of ~s ~s is out of character range"),
+                  anum, bnum, nao);
+      return chr(sum);
+    }
   }
   uw_throwf(error_s, lit("minus: invalid operands ~s ~s"), anum, bnum, nao);
   abort();
@@ -748,11 +784,16 @@ val gt(val anum, val bnum)
 
   switch (TAG_PAIR(tag_a, tag_b)) {
   case TAG_PAIR(TAG_NUM, TAG_NUM):
+  case TAG_PAIR(TAG_CHR, TAG_CHR):
+  case TAG_PAIR(TAG_NUM, TAG_CHR):
+  case TAG_PAIR(TAG_CHR, TAG_NUM):
     return c_num(anum) > c_num(bnum) ? t : nil;
   case TAG_PAIR(TAG_NUM, TAG_PTR):
+  case TAG_PAIR(TAG_CHR, TAG_PTR):
     type_check(bnum, BGNUM);
     return mp_cmp_z(mp(bnum)) == MP_LT ? t : nil;
   case TAG_PAIR(TAG_PTR, TAG_NUM):
+  case TAG_PAIR(TAG_PTR, TAG_CHR):
     type_check(anum, BGNUM);
     return mp_cmp_z(mp(anum)) == MP_GT ? t : nil;
   case TAG_PAIR(TAG_PTR, TAG_PTR):
@@ -771,11 +812,16 @@ val lt(val anum, val bnum)
 
   switch (TAG_PAIR(tag_a, tag_b)) {
   case TAG_PAIR(TAG_NUM, TAG_NUM):
+  case TAG_PAIR(TAG_CHR, TAG_CHR):
+  case TAG_PAIR(TAG_NUM, TAG_CHR):
+  case TAG_PAIR(TAG_CHR, TAG_NUM):
     return c_num(anum) < c_num(bnum) ? t : nil;
   case TAG_PAIR(TAG_NUM, TAG_PTR):
+  case TAG_PAIR(TAG_CHR, TAG_PTR):
     type_check(bnum, BGNUM);
     return mp_cmp_z(mp(bnum)) == MP_GT ? t : nil;
   case TAG_PAIR(TAG_PTR, TAG_NUM):
+  case TAG_PAIR(TAG_PTR, TAG_CHR):
     type_check(anum, BGNUM);
     return mp_cmp_z(mp(anum)) == MP_LT ? t : nil;
   case TAG_PAIR(TAG_PTR, TAG_PTR):
@@ -794,11 +840,16 @@ val ge(val anum, val bnum)
 
   switch (TAG_PAIR(tag_a, tag_b)) {
   case TAG_PAIR(TAG_NUM, TAG_NUM):
+  case TAG_PAIR(TAG_CHR, TAG_CHR):
+  case TAG_PAIR(TAG_NUM, TAG_CHR):
+  case TAG_PAIR(TAG_CHR, TAG_NUM):
     return c_num(anum) >= c_num(bnum) ? t : nil;
   case TAG_PAIR(TAG_NUM, TAG_PTR):
+  case TAG_PAIR(TAG_CHR, TAG_PTR):
     type_check(bnum, BGNUM);
     return mp_cmp_z(mp(bnum)) == MP_LT ? t : nil;
   case TAG_PAIR(TAG_PTR, TAG_NUM):
+  case TAG_PAIR(TAG_PTR, TAG_CHR):
     type_check(anum, BGNUM);
     return mp_cmp_z(mp(anum)) == MP_GT ? t : nil;
   case TAG_PAIR(TAG_PTR, TAG_PTR):
@@ -822,11 +873,16 @@ val le(val anum, val bnum)
 
   switch (TAG_PAIR(tag_a, tag_b)) {
   case TAG_PAIR(TAG_NUM, TAG_NUM):
+  case TAG_PAIR(TAG_CHR, TAG_CHR):
+  case TAG_PAIR(TAG_NUM, TAG_CHR):
+  case TAG_PAIR(TAG_CHR, TAG_NUM):
     return c_num(anum) <= c_num(bnum) ? t : nil;
   case TAG_PAIR(TAG_NUM, TAG_PTR):
+  case TAG_PAIR(TAG_CHR, TAG_PTR):
     type_check(bnum, BGNUM);
     return mp_cmp_z(mp(bnum)) == MP_GT ? t : nil;
   case TAG_PAIR(TAG_PTR, TAG_NUM):
+  case TAG_PAIR(TAG_PTR, TAG_CHR):
     type_check(anum, BGNUM);
     return mp_cmp_z(mp(anum)) == MP_LT ? t : nil;
   case TAG_PAIR(TAG_PTR, TAG_PTR):
diff --git a/eval.c b/eval.c
index eedd2d56..6ba918ed 100644
--- a/eval.c
+++ b/eval.c
@@ -1265,6 +1265,8 @@ void eval_init(void)
   reg_fun(intern(lit("chr-isxdigit"), user_package), func_n1(chr_isxdigit));
   reg_fun(intern(lit("chr-toupper"), user_package), func_n1(chr_toupper));
   reg_fun(intern(lit("chr-tolower"), user_package), func_n1(chr_tolower));
+  reg_fun(intern(lit("num-chr"), user_package), func_n1(num_chr));
+  reg_fun(intern(lit("chr-num"), user_package), func_n1(chr_num));
   reg_fun(intern(lit("chr-str"), user_package), func_n2(chr_str));
   reg_fun(intern(lit("chr-str-set"), user_package), func_n3(chr_str_set));
   reg_fun(intern(lit("span-str"), user_package), func_n2(span_str));
diff --git a/lib.c b/lib.c
index 0062ac94..64cf66eb 100644
--- a/lib.c
+++ b/lib.c
@@ -1488,6 +1488,20 @@ val chr_tolower(val ch)
   return chr(towlower(c_chr(ch)));
 }
 
+val num_chr(val ch)
+{
+  return num_fast(c_chr(ch));
+}
+
+val chr_num(val num)
+{
+  cnum n = c_num(num);
+  if (n < 0 || n > 0x10FFFF)
+    uw_throwf(numeric_error_s,
+              lit("chr-num: ~s is out of character range"), num, nao);
+  return chr(n);
+}
+
 val chr_str(val str, val index)
 {
   bug_unless (length_str_gt(str, index));
diff --git a/lib.h b/lib.h
index a3d6019d..c4a0f72a 100644
--- a/lib.h
+++ b/lib.h
@@ -433,6 +433,8 @@ val chr_isupper(val ch);
 val chr_isxdigit(val ch);
 val chr_toupper(val ch);
 val chr_tolower(val ch);
+val num_chr(val ch);
+val chr_num(val num);
 val chr_str(val str, val index);
 val chr_str_set(val str, val index, val chr);
 val span_str(val str, val set);
diff --git a/txr.1 b/txr.1
index 3eca72ad..5aad3b1b 100644
--- a/txr.1
+++ b/txr.1
@@ -4959,6 +4959,8 @@ The following are Lisp functions and variables built-in to TXR.
 
 .SS Function chr-tolower
 
+.SS Functions num-chr and chr-num
+
 .SS Function chr-str
 
 .SS Function chr-str-set