Move numeric functions from lib.c to arith.c

* arith.c, lib.c (num, c_num, c_fixnum, bad_float, flo, c_flo, fixnump, bignump,
integerp, floatp, numberp nary_op, nary_simple_op, plusv,
minusv, mulv, divv, logandv, logiorv, gtv, ltv, gev, lev,
numeqv, numneqv, sumv, prod, exptv, gcdv, lcmv): Function
definitions moved from lib.c to arith.c.
(nary_op_keyfun, unary_num, unary_arith, unary_int, sumv,
prodv, rexpt, abso_self): Static functions moved from
libmoved from lib.c to arith.c.
(max): New macro in arith.c.
(arith_init): Registrations moved from eval.c.

* eval.c (eval_init): Registrations moved to arith.c

1 files changed, 0 insertions, 410 deletions

diff --git a/lib.c b/lib.c
index 079b840c..ab898277 100644
--- a/lib.c
+++ b/lib.c
@@ -3251,387 +3251,6 @@ val improper_plist_to_alist(val list, val boolean_keys)
   return out;
 }
 
-val num(cnum n)
-{
-  return (n >= NUM_MIN && n <= NUM_MAX) ? num_fast(n) : bignum(n);
-}
-
-cnum c_num(val n)
-{
-  switch (type(n)) {
-  case CHR: case NUM:
-    return coerce(cnum, n) >> TAG_SHIFT;
-  case BGNUM:
-    if (mp_in_intptr_range(mp(n))) {
-      int_ptr_t out;
-      mp_get_intptr(mp(n), &out);
-      return out;
-    }
-    uw_throwf(error_s, lit("~s is out of allowed range [~s, ~s]"),
-              n, num(INT_PTR_MIN), num(INT_PTR_MAX), nao);
-  default:
-    type_mismatch(lit("~s is not an integer"), n, nao);
-  }
-}
-
-cnum c_fixnum(val num, val self)
-{
-  switch (type(num)) {
-  case CHR: case NUM:
-    return coerce(cnum, num) >> TAG_SHIFT;
-  default:
-    type_mismatch(lit("~a: ~s is not fixnum integer or character"),
-                  self, num, nao);
-  }
-}
-
-#if HAVE_FPCLASSIFY
-INLINE int bad_float(double d)
-{
-  switch (fpclassify(d)) {
-  case FP_ZERO:
-  case FP_NORMAL:
-  case FP_SUBNORMAL:
-    return 0;
-  default:
-    return 1;
-  }
-}
-#else
-#define bad_float(d) (0)
-#endif
-
-val flo(double n)
-{
-  if (bad_float(n)) {
-    uw_throw(numeric_error_s, lit("out-of-range floating-point result"));
-  } else {
-    val obj = make_obj();
-    obj->fl.type = FLNUM;
-    obj->fl.n = n;
-    return obj;
-  }
-}
-
-double c_flo(val num, val self)
-{
-  type_check(self, num, FLNUM);
-  return num->fl.n;
-}
-
-val fixnump(val num)
-{
-  return (is_num(num)) ? t : nil;
-}
-
-val bignump(val num)
-{
-  return (type(num) == BGNUM) ? t : nil;
-}
-
-val integerp(val num)
-{
-  switch (tag(num)) {
-  case TAG_NUM:
-    return t;
-  case TAG_PTR:
-    if (num == nil)
-      return nil;
-    if (num->t.type == BGNUM)
-      return t;
-    /* fallthrough */
-  default:
-    return nil;
-  }
-}
-
-val floatp(val num)
-{
-  return (type(num) == FLNUM) ? t : nil;
-}
-
-val numberp(val num)
-{
-  switch (tag(num)) {
-  case TAG_NUM:
-    return t;
-  case TAG_PTR:
-    if (num == nil)
-      return nil;
-    if (num->t.type == BGNUM || num->t.type == FLNUM)
-      return t;
-    /* fallthrough */
-  default:
-    return nil;
-  }
-}
-
-val nary_op(val self, val (*bfun)(val, val),
-            val (*ufun)(val self, val),
-            struct args *args, val emptyval)
-{
-  val acc, next;
-  cnum index = 0;
-
-  if (!args_more(args, index))
-    return emptyval;
-
-  acc = args_get(args, &index);
-
-  if (!args_more(args, index))
-    return ufun(self, acc);
-
-  do {
-    next = args_get(args, &index);
-    acc = bfun(acc, next);
-  } while (args_more(args, index));
-
-  return acc;
-}
-
-static val nary_op_keyfun(val self, val (*bfun)(val, val),
-                          val (*ufun)(val self, val),
-                          struct args *args, val emptyval,
-                          val keyfun)
-{
-  val acc, next;
-  cnum index = 0;
-
-  if (!args_more(args, index))
-    return emptyval;
-
-  acc = funcall1(keyfun, args_get(args, &index));
-
-  if (!args_more(args, index))
-    return ufun(self, acc);
-
-  do {
-    next = funcall1(keyfun, args_get(args, &index));
-    acc = bfun(acc, next);
-  } while (args_more(args, index));
-
-  return acc;
-}
-
-
-val nary_simple_op(val self, val (*bfun)(val, val),
-                   struct args *args, val firstval)
-{
-  val acc = firstval, next;
-  cnum index = 0;
-
-  while (args_more(args, index)) {
-    next = args_get(args, &index);
-    acc = bfun(acc, next);
-  }
-
-  return acc;
-}
-
-static val unary_num(val self, val arg)
-{
-  if (!numberp(arg))
-    uw_throwf(error_s, lit("~a: ~s isn't a number"), self, arg, nao);
-  return arg;
-}
-
-static val unary_arith(val self, val arg)
-{
-  switch (type(arg)) {
-  case NUM:
-  case CHR:
-  case BGNUM:
-  case FLNUM:
-    return arg;
-  default:
-    uw_throwf(error_s, lit("~a: invalid argument ~s"), self, arg, nao);
-  }
-}
-
-static val unary_int(val self, val arg)
-{
-  if (!integerp(arg))
-    uw_throwf(error_s, lit("~a: ~s isn't an integer"), self, arg, nao);
-  return arg;
-}
-
-val plusv(struct args *nlist)
-{
-  return nary_op(lit("+"), plus, unary_arith, nlist, zero);
-}
-
-val minusv(val minuend, struct args *nlist)
-{
-  val acc = minuend, next;
-  cnum index = 0;
-
-  if (!args_more(nlist, index))
-    return neg(acc);
-
-  do {
-    next = args_get(nlist, &index);
-    acc = minus(acc, next);
-  } while (args_more(nlist, index));
-
-  return acc;
-}
-
-val mulv(struct args *nlist)
-{
-  return nary_op(lit("*"), mul, unary_num, nlist, one);
-}
-
-val divv(val dividend, struct args *nlist)
-{
-  val acc = dividend, next;
-  cnum index = 0;
-
-  if (!args_more(nlist, index))
-    return divi(one, acc);
-
-  do {
-    next = args_get(nlist, &index);
-    acc = divi(acc, next);
-  } while (args_more(nlist, index));
-
-  return acc;
-}
-
-val logandv(struct args *nlist)
-{
-  return nary_op(lit("logand"), logand, unary_int, nlist, negone);
-}
-
-val logiorv(struct args *nlist)
-{
-  return nary_op(lit("logior"), logior, unary_int, nlist, zero);
-}
-
-val gtv(val first, struct args *rest)
-{
-  cnum index = 0;
-
-  while (args_more(rest, index)) {
-    val elem = args_get(rest, &index);
-    if (!gt(first, elem))
-      return nil;
-    first = elem;
-  }
-
-  if (index == 0)
-    (void) unary_arith(lit(">"), first);
-
-  return t;
-}
-
-val ltv(val first, struct args *rest)
-{
-  cnum index = 0;
-
-  while (args_more(rest, index)) {
-    val elem = args_get(rest, &index);
-    if (!lt(first, elem))
-      return nil;
-    first = elem;
-  }
-
-  if (index == 0)
-    (void) unary_arith(lit("<"), first);
-
-  return t;
-}
-
-val gev(val first, struct args *rest)
-{
-  cnum index = 0;
-
-  while (args_more(rest, index)) {
-    val elem = args_get(rest, &index);
-    if (!ge(first, elem))
-      return nil;
-    first = elem;
-  }
-
-  if (index == 0)
-    (void) unary_arith(lit(">="), first);
-
-  return t;
-}
-
-val lev(val first, struct args *rest)
-{
-  cnum index = 0;
-
-  while (args_more(rest, index)) {
-    val elem = args_get(rest, &index);
-    if (!le(first, elem))
-      return nil;
-    first = elem;
-  }
-
-  if (index == 0)
-    (void) unary_arith(lit("<="), first);
-
-  return t;
-}
-
-val numeqv(val first, struct args *rest)
-{
-  cnum index = 0;
-
-  while (args_more(rest, index)) {
-    val elem = args_get(rest, &index);
-    if (!numeq(first, elem))
-      return nil;
-    first = elem;
-  }
-
-  if (index == 0)
-    (void) unary_arith(lit("="), first);
-
-  return t;
-}
-
-val numneqv(struct args *args)
-{
-  val i, j;
-  val list = args_get_list(args);
-
-  if (list && !cdr(list)) {
-    (void) unary_arith(lit("/="), car(list));
-    return t;
-  }
-
-  for (i = list; i; i = cdr(i))
-    for (j = cdr(i); j; j = cdr(j))
-      if (numeq(car(i), car(j)))
-        return nil;
-
-  return t;
-}
-
-static val sumv(struct args *nlist, val keyfun)
-{
-  return nary_op_keyfun(lit("+"), plus, unary_arith, nlist, zero, keyfun);
-}
-
-val sum(val seq, val keyfun)
-{
-  args_decl_list(args, ARGS_MIN, tolist(seq));
-  return if3(missingp(keyfun), plusv(args), sumv(args, keyfun));
-}
-
-static val prodv(struct args *nlist, val keyfun)
-{
-  return nary_op_keyfun(lit("*"), mul, unary_num, nlist, one, keyfun);
-}
-
-val prod(val seq, val keyfun)
-{
-  args_decl_list(args, ARGS_MIN, tolist(seq));
-  return if3(missingp(keyfun), mulv(args), prodv(args, keyfun));
-}
-
 val max2(val a, val b)
 {
   return if3(less(a, b), b, a);
@@ -3669,11 +3288,6 @@ val clamp(val low, val high, val num)
   return max2(low, min2(high, num));
 }
 
-static val rexpt(val right, val left)
-{
-  return expt(left, right);
-}
-
 val bracket(val larg, struct args *args)
 {
   cnum index = 0;
@@ -3687,30 +3301,6 @@ val bracket(val larg, struct args *args)
   return num(index);
 }
 
-val exptv(struct args *nlist)
-{
-  cnum nargs = args_count(nlist);
-  args_decl(rnlist, max(ARGS_MIN, nargs));
-  args_copy_reverse(rnlist, nlist, nargs);
-  return nary_op(lit("expt"), rexpt, unary_num, rnlist, one);
-}
-
-static val abso_self(val self, val arg)
-{
-  (void) self;
-  return abso(arg);
-}
-
-val gcdv(struct args *nlist)
-{
-  return nary_op(lit("gcd"), gcd, abso_self, nlist, zero);
-}
-
-val lcmv(struct args *nlist)
-{
-  return nary_op(lit("lcm"), lcm, abso_self, nlist, zero);
-}
-
 val string_own(wchar_t *str)
 {
   val obj = make_obj();