summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog12
-rw-r--r--arith.c56
-rw-r--r--eval.c2
-rw-r--r--lib.c14
-rw-r--r--lib.h2
-rw-r--r--txr.12
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
generated by cgit v1.2.3 (git 2.25.1) at 2025-03-15 23:20:29 +0000