From 02d5a8ff16d1aa82fab7b861788886c08e81f268 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 14 Dec 2011 07:56:27 -0800 Subject: * 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. --- ChangeLog | 12 ++++++++++++ arith.c | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ eval.c | 2 ++ lib.c | 14 ++++++++++++++ lib.h | 2 ++ txr.1 | 2 ++ 6 files changed, 88 insertions(+) diff --git a/ChangeLog b/ChangeLog index 5241c4c1..d2bc23b1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2011-12-14 Kaz Kylheku + + * 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 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 -- cgit v1.2.3