New function: arithp.

* lib.h (arithp): Declared.
(plus_s): Existing symbol declared.

* arith.c (arithp): New function.

* struct.h (special_slot): New enum member plus_m.

* struct.c (special_sym): Register plus_s together as
the [plus_m] entry of the array.

* tests/016/arith.tl
* tests/016/ud-arith.tl: Tests for arithp.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.

8 files changed, 55 insertions, 2 deletions

diff --git a/arith.c b/arith.c
index ae2abb83..2ec83fc0 100644
--- a/arith.c
+++ b/arith.c
@@ -4362,6 +4362,23 @@ val numberp(val num)
   }
 }
 
+val arithp(val obj)
+{
+  switch (type(obj)) {
+  case NUM:
+  case BGNUM:
+  case FLNUM:
+  case CHR:
+  case RNG:
+    return t;
+  default:
+    if (obj_struct_p(obj) && get_special_slot(obj, plus_m))
+      return t;
+  }
+
+  return nil;
+}
+
 val nary_op(val self, val (*bfun)(val, val),
             val (*ufun)(val self, val),
             struct args *args, val emptyval)
@@ -4918,7 +4935,7 @@ void arith_init(void)
   reg_fun(intern(lit("floatp"), user_package), func_n1(floatp));
   reg_fun(intern(lit("integerp"), user_package), func_n1(integerp));
   reg_fun(intern(lit("numberp"), user_package), func_n1(numberp));
-
+  reg_fun(intern(lit("arithp"), user_package), func_n1(arithp));
 
   reg_fun(signum_s, func_n1(signum));
 
diff --git a/lib.h b/lib.h
index f3cd8429..f7e6f992 100644
--- a/lib.h
+++ b/lib.h
@@ -689,6 +689,7 @@ extern val warning_s, defr_warning_s, restart_s, continue_s;
 extern val gensym_counter_s, length_s;
 extern val rplaca_s, rplacd_s, seq_iter_s;
 extern val lazy_streams_s;
+extern val plus_s;
 
 #define gensym_counter (deref(lookup_var_l(nil, gensym_counter_s)))
 
@@ -919,6 +920,7 @@ val bignump(val num);
 val floatp(val num);
 val integerp(val num);
 val numberp(val num);
+val arithp(val obj);
 val nary_op(val self, val (*bfun)(val, val),
             val (*ufun)(val self, val),
             struct args *args, val emptyval);
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index 357b1e65..14d88c7a 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -125,6 +125,7 @@
       ("apply" "N-026C3723")
       ("aret" "N-008216A8")
       ("arg" "N-02133AA5")
+      ("arithp" "N-03DAA473")
       ("array" "N-0117BE95")
       ("arraysize" "N-002129D6")
       ("as" "N-028B26DD")
diff --git a/struct.c b/struct.c
index 04b429cc..da9b8051 100644
--- a/struct.c
+++ b/struct.c
@@ -114,7 +114,8 @@ val iter_begin_s, iter_more_s, iter_item_s, iter_step_s, iter_reset_s;
 static val *special_sym[num_special_slots] = {
   &equal_s, &nullify_s, &from_list_s, &lambda_s, &lambda_set_s,
   &length_s, &car_s, &cdr_s, &rplaca_s, &rplacd_s,
-  &iter_begin_s, &iter_more_s, &iter_item_s, &iter_step_s, &iter_reset_s
+  &iter_begin_s, &iter_more_s, &iter_item_s, &iter_step_s, &iter_reset_s,
+  &plus_s
 };
 
 static struct cobj_class *struct_type_cls;
diff --git a/struct.h b/struct.h
index 4b442fb7..213a4b91 100644
--- a/struct.h
+++ b/struct.h
@@ -39,6 +39,7 @@ enum special_slot {
   equal_m, nullify_m, from_list_m, lambda_m, lambda_set_m,
   length_m, car_m, cdr_m, rplaca_m, rplacd_m,
   iter_begin_m, iter_more_m, iter_item_m, iter_step_m, iter_reset_m,
+  plus_m,
   num_special_slots
 };
 
diff --git a/tests/016/arith.tl b/tests/016/arith.tl
index 86b5d9bb..d67b9908 100644
--- a/tests/016/arith.tl
+++ b/tests/016/arith.tl
@@ -405,3 +405,10 @@
 (test
   (build (each-prod* ((i '(b c)) (j (cons 'a i))) (add (list i j))))
   ((b a) (b b) (b c) (c a) (c b) (c c)))
+
+(mtest
+  (arithp #\a) t
+  (arithp 42) t
+  (arithp 3.14) t
+  (arithp (expt 2 200)) t
+  (arithp #R(nil nil)) t)
diff --git a/tests/016/ud-arith.tl b/tests/016/ud-arith.tl
index 052fcaed..5d07349a 100644
--- a/tests/016/ud-arith.tl
+++ b/tests/016/ud-arith.tl
@@ -138,3 +138,5 @@
 (test (ash n 0) (ash 1 0))
 (test (width n) (width 1))
 (test (logcount n) (logcount 1))
+
+(test (arithp n) t)
diff --git a/txr.1 b/txr.1
index f580ed8c..f7680b13 100644
--- a/txr.1
+++ b/txr.1
@@ -48806,6 +48806,28 @@ a
 or
 .codn float .
 
+.coNP Function @ arithp
+.synb
+.mets (arithp << object )
+.syne
+.desc
+The
+.code arithp
+function returns true if
+.met object
+is a character, integer, floating-point number, range or a user-defined arithmetic object.
+For a range,
+.code t
+is returned without examining the values of the
+.code from
+and
+.code to
+fields.
+A user-defined arithmetic object is identified as a struct type which
+implements the
+.code +
+method as a static slot.
+
 .coNP Functions @ zerop and @ nzerop
 .synb
 .mets (zerop << number )