New function: signum.

arith.c (signum): New function.
(arith_init): signum intrinsic registered.

* txr.1: Documented.

2 files changed, 47 insertions, 0 deletions

diff --git a/arith.c b/arith.c
index 7b02863a..493492a3 100644
--- a/arith.c
+++ b/arith.c
@@ -748,6 +748,26 @@ val abso(val anum)
   }
 }
 
+static val signum(val anum)
+{
+  switch (type(anum)) {
+  case BGNUM:
+    return if3(ISNEG(mp(anum)), negone, one);
+  case FLNUM:
+    {
+      double a = anum->fl.n;
+      return flo(if3(a > 0, 1.0, if3(a < 0, -1.0, 0.0)));
+    }
+  case NUM:
+    {
+      cnum a = c_num(anum);
+      return if3(a > 0, one, if3(a < 0, negone, zero));
+    }
+  default:
+    uw_throwf(error_s, lit("signum: ~s is not a number"), anum, nao);
+  }
+}
+
 val mul(val anum, val bnum)
 {
   val self = lit("*");
@@ -3176,6 +3196,8 @@ void arith_init(void)
   reg_varl(intern(lit("*e*"), user_package), flo(M_E));
   reg_varl(intern(lit("%e%"), user_package), flo(M_E));
 
+  reg_fun(intern(lit("signum"), user_package), func_n1(signum));
+
   reg_fun(intern(lit("bignum-len"), user_package), func_n1(bignum_len));
   reg_fun(intern(lit("divides"), user_package), func_n2(divides));
   reg_fun(intern(lit("bits"), system_package), func_n1(bits));
diff --git a/txr.1 b/txr.1
index 4f04d3aa..bced33a0 100644
--- a/txr.1
+++ b/txr.1
@@ -34863,6 +34863,31 @@ is positive, it is returned. If
 is negative, its additive inverse is
 returned: a positive number of the same type with exactly the same magnitude.
 
+.coNP Function @ signum
+.synb
+.mets (signum << number )
+.syne
+.desc
+The
+.code signum
+function calculates a representation of the sign of
+.meta number
+as a numeric value.
+
+If
+.meta number
+is an integer, then
+.code signum
+returns -1 if the integer is negative, 1 if the integer is positive,
+or else 0.
+
+If
+.meta number
+is a floating-point value then
+.code signum
+returns -1.0 if the value is negative, 1.0 if the value is positive or
+else 0.0.
+
 .coNP Functions @, trunc @, floor @ ceil and @ round
 .synb
 .mets (trunc < dividend <> [ divisor ])