diff options
-rw-r--r-- | ChangeLog | 12 | ||||
-rw-r--r-- | arith.c | 56 | ||||
-rw-r--r-- | eval.c | 2 | ||||
-rw-r--r-- | lib.c | 14 | ||||
-rw-r--r-- | lib.h | 2 | ||||
-rw-r--r-- | txr.1 | 2 |
6 files changed, 88 insertions, 0 deletions
@@ -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 @@ -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): @@ -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)); @@ -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)); @@ -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); @@ -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 |