From d91ed5da5a5ea74308ad78faec31e03c48b7e767 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 12 Jan 2015 22:49:37 -0800
Subject: * arith.c (zerop): Handle character arguments. (plusp, minusp): New
 functions.

* eval.c (eval_init): Register plusp and minusp.

* lib.h (plusp, minusp): Declared.

* txr.1: Documented plusp and minusp, and the
handling of characters by zerop.
---
 ChangeLog | 12 ++++++++++++
 arith.c   | 34 ++++++++++++++++++++++++++++++++++
 eval.c    |  2 ++
 lib.h     |  2 ++
 txr.1     | 27 ++++++++++++++++++++++++++-
 5 files changed, 76 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index 26881aee..4841af53 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2015-01-12  Kaz Kylheku  <kaz@kylheku.com>
+
+	* arith.c (zerop): Handle character arguments.
+	(plusp, minusp): New functions.
+
+	* eval.c (eval_init): Register plusp and minusp.
+
+	* lib.h (plusp, minusp): Declared.
+
+	* txr.1: Documented plusp and minusp, and the
+	handling of characters by zerop.
+
 2015-01-12  Kaz Kylheku  <kaz@kylheku.com>
 
 	Fix for LLVM wchar_t literals not being four byte
diff --git a/arith.c b/arith.c
index 058a4e1d..365818e3 100644
--- a/arith.c
+++ b/arith.c
@@ -993,11 +993,45 @@ val zerop(val num)
     return nil;
   case FLNUM:
     return if2(c_flo(num) == 0.0, t);
+  case CHR:
+    return if2(num == chr(0), t);
   default:
     uw_throwf(error_s, lit("zerop: ~s is not a number"), num, nao);
   }
 }
 
+val plusp(val num)
+{
+  switch (type(num)) {
+  case NUM:
+    return if2(c_num(num) > 0, t);
+  case BGNUM:
+    return if2(mp_cmp_z(mp(num)) == MP_GT, t);
+  case FLNUM:
+    return if2(c_flo(num) > 0.0, t);
+  case CHR:
+    return if2(num != chr(0), t);
+  default:
+    uw_throwf(error_s, lit("plusp: ~s is not a number"), num, nao);
+  }
+}
+
+val minusp(val num)
+{
+  switch (type(num)) {
+  case NUM:
+    return if2(c_num(num) < 0, t);
+  case BGNUM:
+    return if2(mp_cmp_z(mp(num)) == MP_LT, t);
+  case FLNUM:
+    return if2(c_flo(num) < 0.0, t);
+  case CHR:
+    return nil;
+  default:
+    uw_throwf(error_s, lit("minusp: ~s is not a number"), num, nao);
+  }
+}
+
 val evenp(val num)
 {
   switch (type(num)) {
diff --git a/eval.c b/eval.c
index b02e4d0b..429d9352 100644
--- a/eval.c
+++ b/eval.c
@@ -3728,6 +3728,8 @@ void eval_init(void)
   reg_fun(intern(lit("numberp"), user_package), func_n1(numberp));
 
   reg_fun(intern(lit("zerop"), user_package), func_n1(zerop));
+  reg_fun(intern(lit("plusp"), user_package), func_n1(plusp));
+  reg_fun(intern(lit("minusp"), user_package), func_n1(minusp));
   reg_fun(intern(lit("evenp"), user_package), func_n1(evenp));
   reg_fun(intern(lit("oddp"), user_package), func_n1(oddp));
   reg_fun(intern(lit("succ"), user_package), func_n1(succ));
diff --git a/lib.h b/lib.h
index e55a3516..378973e6 100644
--- a/lib.h
+++ b/lib.h
@@ -545,6 +545,8 @@ val wrap_star(val start, val end, val num);
 val wrap(val start, val end, val num);
 val divi(val anum, val bnum);
 val zerop(val num);
+val plusp(val num);
+val minusp(val num);
 val evenp(val num);
 val oddp(val num);
 val succ(val num);
diff --git a/txr.1 b/txr.1
index ab73733e..c26ab041 100644
--- a/txr.1
+++ b/txr.1
@@ -18677,7 +18677,7 @@ The
 function tests
 .meta number
 for equivalence to zero. The argument must be
-a number. It returns
+a number or character. It returns
 .code t
 for the integer value
 .code 0
@@ -18686,6 +18686,31 @@ value
 .codn 0.0 .
 For other numbers, it returns
 .codn nil .
+It returns
+.code t
+for the null character
+.code #\enul
+and
+.code nil
+for all other characters.
+
+.coNP Functions @ plusp and @ minusp
+.synb
+.mets (plusp << number )
+.mets (minusp << number )
+.syne
+.desc
+These functions test whether a number is positive or negative,
+returning
+.code t
+or
+.codn nil ,
+as the case may be.
+
+The argument may also be a character. All characters other than
+the null character
+.code #\enul
+are positive. No character is negative.
 
 .coNP Functions @ evenp and @ oddp
 .synb
-- 
cgit v1.2.3