From 64b06932ed7d8dd8c904e66a70a53ae4c8ec4448 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 13 Dec 2011 19:37:19 -0800
Subject: * arith.c (evenp, oddp): New functions.

* eval.c (eval_init): New functions registered as intrinsics.

* lib.h (evenp, oddp): Declared.

* txr.1: Documentation stub updated.
---
 ChangeLog | 10 ++++++++++
 arith.c   | 30 ++++++++++++++++++++++++++++++
 eval.c    |  2 ++
 lib.h     |  2 ++
 txr.1     |  2 +-
 5 files changed, 45 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index 0637746f..39e95ff2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2011-12-13  Kaz Kylheku  <kaz@kylheku.com>
+
+	* arith.c (evenp, oddp): New functions.
+
+	* eval.c (eval_init): New functions registered as intrinsics.
+
+	* lib.h (evenp, oddp): Declared.
+
+	* txr.1: Documentation stub updated.
+
 2011-12-13  Kaz Kylheku  <kaz@kylheku.com>
 
 	* arith.c (highest_bit): Linkage changed to static.
diff --git a/arith.c b/arith.c
index 1ccab1f6..bde39aad 100644
--- a/arith.c
+++ b/arith.c
@@ -711,6 +711,36 @@ val zerop(val num)
   return nil;
 }
 
+val evenp(val num)
+{
+  switch (tag(num)) {
+  case TAG_NUM:
+    return (c_num(num) % 2 == 0) ? t : nil;
+  case TAG_PTR:
+    if (num->t.type == BGNUM)
+      return mp_iseven(mp(num)) ? t : nil;
+    /* fallthrough */
+  default:
+    uw_throwf(error_s, lit("evenp: ~s is not a number"), num, nao);
+    return nil;
+  }
+}
+
+val oddp(val num)
+{
+  switch (tag(num)) {
+  case TAG_NUM:
+    return (c_num(num) % 2 != 0) ? t : nil;
+  case TAG_PTR:
+    if (num->t.type == BGNUM)
+      return mp_isodd(mp(num)) ? t : nil;
+    /* fallthrough */
+  default:
+    uw_throwf(error_s, lit("oddp: ~s is not a number"), num, nao);
+    return nil;
+  }
+}
+
 val gt(val anum, val bnum)
 {
   int tag_a = tag(anum);
diff --git a/eval.c b/eval.c
index 30a1beed..c886e89f 100644
--- a/eval.c
+++ b/eval.c
@@ -1166,6 +1166,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("evenp"), user_package), func_n1(evenp));
+  reg_fun(intern(lit("oddp"), user_package), func_n1(oddp));
   reg_fun(intern(lit(">"), user_package), func_n1v(gtv));
   reg_fun(intern(lit("<"), user_package), func_n1v(ltv));
   reg_fun(intern(lit(">="), user_package), func_n1v(gev));
diff --git a/lib.h b/lib.h
index 5874d73e..e206184e 100644
--- a/lib.h
+++ b/lib.h
@@ -375,6 +375,8 @@ val mulv(val nlist);
 val trunc(val anum, val bnum);
 val mod(val anum, val bnum);
 val zerop(val num);
+val evenp(val num);
+val oddp(val num);
 val gt(val anum, val bnum);
 val lt(val anum, val bnum);
 val ge(val anum, val bnum);
diff --git a/txr.1 b/txr.1
index a5ebdc06..d2f58d4e 100644
--- a/txr.1
+++ b/txr.1
@@ -4815,7 +4815,7 @@ The following are Lisp functions and variables built-in to TXR.
 
 .SS Functions fixnump, bignump, numberp
 
-.SS Function zerop
+.SS Functions zerop, evenp, oddp
 
 .SS Relational functions >, <, >= and <=
 
-- 
cgit v1.2.3