From 64b06932ed7d8dd8c904e66a70a53ae4c8ec4448 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku 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 + + * 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 * 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