New feature: user-defined math.

Most of the library now accepts struct objects as
arguments, relying on them to implement methods.

* arith.c (minus_s, inv_minus_s, neg_s, abs_s, signum_s,
mul_s, div_s, recip_s, inv_div_s, trunc1_s, trunc_s,
r_trunc_s, mod_s, r_mod_s, zerop_s, plusp_s, minusp_s,
evenp_s, oddp_s, gt_s, lt_s, ge_s, le_s, numeq_s, expt_s,
r_expt_s, exptmod_s, isqrt_s, square_s, floor_s, floor1_s,
r_floor_s, ceil_s, ceil1_s, round_s, round1_s, sin_s, cos_s,
tan_s, asin_s, acos_s, atan_s, atan2_s, r_atan2_s, log_s,
log2_s, log10_s, exp_s, sqrt_s, logand_s, logior_s, logxor_s,
lognot1_s, lognot_s, r_lognot_s, logtrunc_s, r_logtrunc_s,
sign_extend_s, ash_s, bit_s, width_s, logcount_s): New symbol
variables.
(not_struct_error, method_error, do_unary_method,
do_binary_method, do_ternary_method): New static functions.
(plus, minus, neg, abso, signum, mul, trunc1, trunc, mod,
floordiv, round1, roundiv, divi, zerop, plusp, minusp, evenp,
oddp, gt, lt, ge, le, numeq, expt, exptmod, isqrt, square,
floorf, ceili, since, cosi, tang, asine, atang, atang2, loga,
logten, logtwo, expo, sqroot, logand, logior, logxor,
comp_trunc, lognot, sign_extend, ash, bit, logcount, width,
bits, unary_num, unary_arith): Support struct arguments.
(plusv, minusv, mulv, divv, sumv, prodv, gtv, ltv, gev, lev,
numeqv, exptv, logandv, logiorv): Use symbol for self instead
of string lit.
(arith_init): Initialize new symbol variables. Replace
existing intern calls in function registrations with
references to some of these symbol variables.

* txr.1: Documented.

2 files changed, 1041 insertions, 135 deletions

diff --git a/arith.c b/arith.c
index 28e61242..c67dc1d5 100644
--- a/arith.c
+++ b/arith.c
@@ -47,6 +47,7 @@
 #include "args.h"
 #include "eval.h"
 #include "itypes.h"
+#include "struct.h"
 #include "txr.h"
 #include "arith.h"
 
@@ -57,7 +58,19 @@
 #define CNUM_BIT ((int) sizeof (cnum) * CHAR_BIT)
 #define ABS(A) ((A) < 0 ? -(A) : (A))
 
-val plus_s;
+val plus_s, minus_s, inv_minus_s, neg_s, abs_s, signum_s;
+val mul_s, div_s, recip_s, inv_div_s;
+val trunc1_s, trunc_s, r_trunc_s, mod_s, r_mod_s;
+val zerop_s, plusp_s, minusp_s, evenp_s, oddp_s;
+val gt_s, lt_s, ge_s, le_s, numeq_s;
+val expt_s, r_expt_s, exptmod_s, isqrt_s, square_s;
+val floor_s, floor1_s, r_floor_s;
+val ceil_s, ceil1_s, round_s, round1_s;
+val sin_s, cos_s, tan_s, asin_s, acos_s, atan_s, atan2_s, r_atan2_s;
+val log_s, log2_s, log10_s, exp_s, sqrt_s;
+val logand_s, logior_s, logxor_s;
+val lognot1_s, lognot_s, r_lognot_s, logtrunc_s, r_logtrunc_s;
+val sign_extend_s, ash_s, bit_s, width_s, logcount_s;
 
 val make_bignum(void)
 {
@@ -463,9 +476,60 @@ void do_mp_error(val self, mp_err code)
   uw_throwf(numeric_error_s, lit("~a: ~a"), self, errstr, nao);
 }
 
+static noreturn void not_struct_error(val self, val obj)
+{
+  uw_throwf(error_s, lit("~a: ~s isn't a structure"),
+            self, obj, nao);
+}
+
+static noreturn void method_error(val self, val obj, val fun)
+{
+  uw_throwf(error_s, lit("~a: object ~s lacks ~a method"),
+            self, obj, fun, nao);
+}
+
+static val do_unary_method(val self, val sym, val obj)
+{
+  val meth = maybe_slot(obj, sym);
+
+  if (!obj_struct_p(obj))
+    not_struct_error(self, obj);
+
+  if (!meth)
+    method_error(self, obj, sym);
+
+  return funcall1(meth, obj);
+}
+
+static val do_binary_method(val self, val sym, val obj, val arg)
+{
+  val meth = maybe_slot(obj, sym);
+
+  if (!obj_struct_p(obj))
+    not_struct_error(self, obj);
+
+  if (!meth)
+    method_error(self, obj, sym);
+
+  return funcall2(meth, obj, arg);
+}
+
+static val do_ternary_method(val self, val sym, val obj, val arg1, val arg2)
+{
+  val meth = maybe_slot(obj, sym);
+
+  if (!obj_struct_p(obj))
+    not_struct_error(self, obj);
+
+  if (!meth)
+    method_error(self, obj, sym);
+
+  return funcall3(meth, obj, arg1, arg2);
+}
+
 val plus(val anum, val bnum)
 {
-  val self = lit("+");
+  val self = plus_s;
 
 tail:
   switch (TAG_PAIR(tag(anum), tag(bnum))) {
@@ -510,6 +574,8 @@ tail:
       return flo(c_n(anum) + c_flo(bnum, self));
     case RNG:
       return rcons(plus(anum, from(bnum)), plus(anum, to(bnum)));
+    case COBJ:
+      return do_binary_method(self, self, bnum, anum);
     default:
       break;
     }
@@ -545,6 +611,8 @@ tail:
       return flo(c_n(bnum) + c_flo(anum, self));
     case RNG:
       return rcons(plus(from(anum), bnum), plus(to(anum), bnum));
+    case COBJ:
+      return do_binary_method(self, self, anum, bnum);
     default:
       break;
     }
@@ -577,6 +645,11 @@ tail:
     case TYPE_PAIR(RNG, BGNUM):
     case TYPE_PAIR(RNG, FLNUM):
       return rcons(plus(from(anum), bnum), plus(to(anum), bnum));
+    case TYPE_PAIR(COBJ, BGNUM):
+    case TYPE_PAIR(COBJ, FLNUM):
+    case TYPE_PAIR(COBJ, RNG):
+    case TYPE_PAIR(COBJ, COBJ):
+      return do_binary_method(self, self, anum, bnum);
     default:
       break;
     }
@@ -619,7 +692,7 @@ char_range:
 
 val minus(val anum, val bnum)
 {
-  val self = lit("-");
+  val self = minus_s;
 
 tail:
   switch (TAG_PAIR(tag(anum), tag(bnum))) {
@@ -669,6 +742,8 @@ tail:
       return flo(c_n(anum) - c_flo(bnum, self));
     case RNG:
       return rcons(minus(anum, from(bnum)), minus(anum, to(bnum)));
+    case COBJ:
+      return do_binary_method(self, inv_minus_s, bnum, anum);
     default:
       break;
     }
@@ -704,6 +779,8 @@ tail:
       return flo(c_flo(anum, self) - c_n(bnum));
     case RNG:
       return rcons(minus(from(anum), bnum), minus(to(anum), bnum));
+    case COBJ:
+      return do_binary_method(self, self, anum, bnum);
     default:
       break;
     }
@@ -736,6 +813,11 @@ tail:
     case TYPE_PAIR(RNG, BGNUM):
     case TYPE_PAIR(RNG, FLNUM):
       return rcons(minus(from(anum), bnum), minus(to(anum), bnum));
+    case TYPE_PAIR(COBJ, BGNUM):
+    case TYPE_PAIR(COBJ, FLNUM):
+    case TYPE_PAIR(COBJ, RNG):
+    case TYPE_PAIR(COBJ, COBJ):
+      return do_binary_method(self, self, anum, bnum);
     default:
       break;
     }
@@ -767,7 +849,7 @@ tail:
 
 val neg(val anum)
 {
-  val self = lit("-");
+  val self = minus_s;
 
   switch (type(anum)) {
   case BGNUM:
@@ -782,6 +864,8 @@ val neg(val anum)
     return num(-c_n(anum));
   case RNG:
     return rcons(neg(from(anum)), neg(to(anum)));
+  case COBJ:
+    return do_unary_method(self, neg_s, anum);
   default:
     not_number(self, anum);
   }
@@ -789,7 +873,7 @@ val neg(val anum)
 
 val abso(val anum)
 {
-  val self = lit("abs");
+  val self = abs_s;
 
   switch (type(anum)) {
   case BGNUM:
@@ -807,6 +891,8 @@ val abso(val anum)
     }
   case RNG:
     return rcons(abso(from(anum)), abso(to(anum)));
+  case COBJ:
+    return do_unary_method(self, self, anum);
   default:
     not_number(self, anum);
   }
@@ -814,6 +900,8 @@ val abso(val anum)
 
 static val signum(val anum)
 {
+  val self = signum_s;
+
   switch (type(anum)) {
   case BGNUM:
     return if3(mp_isneg(mp(anum)), negone, one);
@@ -827,14 +915,16 @@ static val signum(val anum)
       cnum a = c_n(anum);
       return if3(a > 0, one, if3(a < 0, negone, zero));
     }
+  case COBJ:
+    return do_unary_method(self, self, anum);
   default:
-    not_number(lit("signum"), anum);
+    not_number(self, anum);
   }
 }
 
 val mul(val anum, val bnum)
 {
-  val self = lit("*");
+  val self = mul_s;
 
 tail:
   switch (TAG_PAIR(tag(anum), tag(bnum))) {
@@ -900,6 +990,8 @@ tail:
       return flo(c_n(anum) * c_flo(bnum, self));
     case RNG:
       return rcons(mul(anum, from(bnum)), mul(anum, to(bnum)));
+    case COBJ:
+      return do_binary_method(self, self, bnum, anum);
     default:
       break;
     }
@@ -934,6 +1026,8 @@ tail:
       return flo(c_flo(anum, self) * c_n(bnum));
     case RNG:
       return rcons(mul(from(anum), bnum), mul(to(anum), bnum));
+    case COBJ:
+      return do_binary_method(self, self, anum, bnum);
     default:
       break;
     }
@@ -966,6 +1060,11 @@ tail:
     case TYPE_PAIR(RNG, BGNUM):
     case TYPE_PAIR(RNG, FLNUM):
       return rcons(mul(from(anum), bnum), mul(to(anum), bnum));
+    case TYPE_PAIR(COBJ, BGNUM):
+    case TYPE_PAIR(COBJ, FLNUM):
+    case TYPE_PAIR(COBJ, RNG):
+    case TYPE_PAIR(COBJ, COBJ):
+      return do_binary_method(self, self, anum, bnum);
     default:
       break;
     }
@@ -987,6 +1086,8 @@ static val trunc1(val self, val num)
     }
   case RNG:
     return rcons(trunc1(self, from(num)), trunc1(self, to(num)));
+  case COBJ:
+    return do_unary_method(self, trunc1_s, num);
   default:
     break;
   }
@@ -1000,7 +1101,7 @@ static noreturn void divzero(val self)
 
 val trunc(val anum, val bnum)
 {
-  val self = lit("trunc");
+  val self = trunc_s;
 
   if (missingp(bnum))
     return trunc1(self, anum);
@@ -1034,6 +1135,8 @@ tail:
         else
           return flo((x - fmod(x, y))/y);
       }
+    case COBJ:
+      return do_binary_method(self, r_trunc_s, bnum, anum);
     default:
       break;
     }
@@ -1075,6 +1178,8 @@ tail:
       }
     case RNG:
       return rcons(trunc(from(anum), bnum), trunc(to(anum), bnum));
+    case COBJ:
+      return do_binary_method(self, self, anum, bnum);
     default:
       break;
     }
@@ -1106,6 +1211,10 @@ tail:
     case TYPE_PAIR(RNG, BGNUM):
     case TYPE_PAIR(RNG, FLNUM):
       return rcons(trunc(from(anum), bnum), trunc(to(anum), bnum));
+    case TYPE_PAIR(COBJ, BGNUM):
+    case TYPE_PAIR(COBJ, FLNUM):
+    case TYPE_PAIR(COBJ, COBJ):
+      return do_binary_method(self, self, anum, bnum);
     }
   }
   invalid_ops(self, anum, bnum);
@@ -1126,7 +1235,7 @@ static double dmod(double a, double b)
 
 val mod(val anum, val bnum)
 {
-  val self = lit("mod");
+  val self = mod_s;
 
 tail:
   switch (TAG_PAIR(tag(anum), tag(bnum))) {
@@ -1175,6 +1284,8 @@ tail:
       }
     case FLNUM:
       return flo(dmod(c_n(anum), c_flo(bnum, self)));
+    case COBJ:
+      return do_binary_method(self, r_mod_s, bnum, anum);
     default:
       break;
     }
@@ -1226,6 +1337,8 @@ tail:
       }
     case FLNUM:
       return flo(dmod(c_flo(anum, self), c_n(bnum)));
+    case COBJ:
+      return do_binary_method(self, self, anum, bnum);
     default:
       break;
     }
@@ -1263,6 +1376,10 @@ tail:
     case TYPE_PAIR(FLNUM, BGNUM):
       bnum = flo_int(bnum);
       goto tail;
+    case TYPE_PAIR(COBJ, BGNUM):
+    case TYPE_PAIR(COBJ, FLNUM):
+    case TYPE_PAIR(COBJ, COBJ):
+      return do_binary_method(self, self, anum, bnum);
     }
   }
   invalid_ops(self, anum, bnum);
@@ -1272,7 +1389,7 @@ divzero:
 
 val floordiv(val anum, val bnum)
 {
-  val self = lit("floor");
+  val self = floor_s;
 
   if (missingp(bnum))
     return floorf(anum);
@@ -1320,6 +1437,8 @@ tail:
         else
           return flo((x - dmod(x, y))/y);
       }
+    case COBJ:
+      return do_binary_method(self, r_floor_s, bnum, anum);
     default:
       break;
     }
@@ -1379,6 +1498,8 @@ tail:
       }
     case RNG:
       return rcons(floordiv(from(anum), bnum), floordiv(to(anum), bnum));
+    case COBJ:
+      return do_binary_method(self, self, anum, bnum);
     default:
       break;
     }
@@ -1421,6 +1542,10 @@ tail:
     case TYPE_PAIR(RNG, BGNUM):
     case TYPE_PAIR(RNG, FLNUM):
       return rcons(floordiv(from(anum), bnum), floordiv(to(anum), bnum));
+    case TYPE_PAIR(COBJ, BGNUM):
+    case TYPE_PAIR(COBJ, FLNUM):
+    case TYPE_PAIR(COBJ, COBJ):
+      return do_binary_method(self, self, anum, bnum);
     }
   }
   invalid_ops(self, anum, bnum);
@@ -1454,6 +1579,8 @@ static val round1(val self, val num)
 #endif
   case RNG:
     return rcons(round1(self, from(num)), round1(self, to(num)));
+  case COBJ:
+    return do_unary_method(self, round1_s, num);
   default:
     break;
   }
@@ -1463,7 +1590,7 @@ static val round1(val self, val num)
 
 val roundiv(val anum, val bnum)
 {
-  val self = lit("round");
+  val self = round_s;
 
   if (missingp(bnum))
     return round1(self, anum);
@@ -1553,15 +1680,23 @@ static val to_float(val func, val num)
 
 val divi(val anum, val bnum)
 {
-  val self = lit("/");
+  val self = div_s;
 
   if (missingp(bnum)) {
-    double b = c_flo(to_float(self, anum), self);
-    if (b == 0.0)
-      goto divzero;
-    return flo(1.0 / b);
+    if (cobjp(bnum)) {
+      return do_unary_method(self, recip_s, anum);
+    } else {
+      double b = c_flo(to_float(self, anum), self);
+      if (b == 0.0)
+        goto divzero;
+      return flo(1.0 / b);
+    }
   } else if (type(anum) == RNG) {
     return rcons(divi(from(anum), bnum), divi(to(anum), bnum));
+  } else if (type(bnum) == COBJ) {
+    return do_binary_method(self, inv_div_s, bnum, anum);
+  } else if (type(anum) == COBJ) {
+    return do_binary_method(self, self, anum, bnum);
   } else {
     double a = c_flo(to_float(self, anum), self);
     double b = c_flo(to_float(self, bnum), self);
@@ -1577,7 +1712,7 @@ divzero:
 
 val zerop(val num)
 {
-  val self = lit("zerop");
+  val self = zerop_s;
 
   if (num == zero)
     return t;
@@ -1592,6 +1727,8 @@ val zerop(val num)
     return tnil(num == chr(0));
   case RNG:
     return and2(zerop(from(num)), zerop(to(num)));
+  case COBJ:
+    return do_unary_method(self, self, num);
   default:
     not_number(self, num);
   }
@@ -1614,6 +1751,8 @@ val nzerop(val num)
     return tnil(num != chr(0));
   case RNG:
     return tnil(nzerop(from(num)) || nzerop(to(num)));
+  case COBJ:
+    return tnil(!do_unary_method(self, zerop_s, num));
   default:
     not_number(self, num);
   }
@@ -1621,7 +1760,7 @@ val nzerop(val num)
 
 val plusp(val num)
 {
-  val self = lit("plusp");
+  val self = plusp_s;
 
   switch (type(num)) {
   case NUM:
@@ -1632,6 +1771,8 @@ val plusp(val num)
     return tnil(c_flo(num, self) > 0.0);
   case CHR:
     return tnil(num != chr(0));
+  case COBJ:
+    return do_unary_method(self, self, num);
   default:
     not_number(self, num);
   }
@@ -1639,7 +1780,7 @@ val plusp(val num)
 
 val minusp(val num)
 {
-  val self = lit("minusp");
+  val self = minusp_s;
 
   switch (type(num)) {
   case NUM:
@@ -1650,6 +1791,8 @@ val minusp(val num)
     return tnil(c_flo(num, self) < 0.0);
   case CHR:
     return nil;
+  case COBJ:
+    return do_unary_method(self, self, num);
   default:
     not_number(self, num);
   }
@@ -1657,26 +1800,33 @@ val minusp(val num)
 
 val evenp(val num)
 {
+  val self = evenp_s;
+
   switch (type(num)) {
   case NUM:
     return (c_n(num) % 2 == 0) ? t : nil;
   case BGNUM:
     return mp_iseven(mp(num)) ? t : nil;
+  case COBJ:
+    return do_unary_method(self, self, num);
   default:
-    not_integer(lit("evenp"), num);
+    not_integer(self, num);
   }
 }
 
 val oddp(val num)
 {
+  val self = oddp_s;
+
   switch (type(num)) {
   case NUM:
     return (c_n(num) % 2 != 0) ? t : nil;
   case BGNUM:
     return mp_isodd(mp(num)) ? t : nil;
+  case COBJ:
+    return do_unary_method(self, self, num);
   default:
-    not_integer(lit("oddp"), num);
-    return nil;
+    not_integer(self, num);
   }
 }
 
@@ -1712,7 +1862,7 @@ val pppred(val num)
 
 val gt(val anum, val bnum)
 {
-  val self = lit(">");
+  val self = gt_s;
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
@@ -1755,6 +1905,19 @@ tail:
 
       return nil;
     }
+  case TYPE_PAIR(COBJ, NUM):
+  case TYPE_PAIR(COBJ, CHR):
+  case TYPE_PAIR(COBJ, BGNUM):
+  case TYPE_PAIR(COBJ, FLNUM):
+  case TYPE_PAIR(COBJ, RNG):
+  case TYPE_PAIR(COBJ, COBJ):
+    return do_binary_method(self, self, anum, bnum);
+  case TYPE_PAIR(NUM, COBJ):
+  case TYPE_PAIR(CHR, COBJ):
+  case TYPE_PAIR(BGNUM, COBJ):
+  case TYPE_PAIR(FLNUM, COBJ):
+  case TYPE_PAIR(RNG, COBJ):
+    return do_binary_method(self, lt_s, bnum, anum);
   }
 
   invalid_ops(self, anum, bnum);
@@ -1762,7 +1925,7 @@ tail:
 
 val lt(val anum, val bnum)
 {
-  val self = lit("<");
+  val self = lt_s;
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
@@ -1805,6 +1968,19 @@ tail:
 
       return nil;
     }
+  case TYPE_PAIR(COBJ, NUM):
+  case TYPE_PAIR(COBJ, CHR):
+  case TYPE_PAIR(COBJ, BGNUM):
+  case TYPE_PAIR(COBJ, FLNUM):
+  case TYPE_PAIR(COBJ, RNG):
+  case TYPE_PAIR(COBJ, COBJ):
+    return do_binary_method(self, self, anum, bnum);
+  case TYPE_PAIR(NUM, COBJ):
+  case TYPE_PAIR(CHR, COBJ):
+  case TYPE_PAIR(BGNUM, COBJ):
+  case TYPE_PAIR(FLNUM, COBJ):
+  case TYPE_PAIR(RNG, COBJ):
+    return do_binary_method(self, gt_s, bnum, anum);
   }
 
   invalid_ops(self, anum, bnum);
@@ -1812,7 +1988,7 @@ tail:
 
 val ge(val anum, val bnum)
 {
-  val self = lit(">=");
+  val self = ge_s;
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
@@ -1860,6 +2036,19 @@ tail:
 
       return nil;
     }
+  case TYPE_PAIR(COBJ, NUM):
+  case TYPE_PAIR(COBJ, CHR):
+  case TYPE_PAIR(COBJ, BGNUM):
+  case TYPE_PAIR(COBJ, FLNUM):
+  case TYPE_PAIR(COBJ, RNG):
+  case TYPE_PAIR(COBJ, COBJ):
+    return do_binary_method(self, self, anum, bnum);
+  case TYPE_PAIR(NUM, COBJ):
+  case TYPE_PAIR(CHR, COBJ):
+  case TYPE_PAIR(BGNUM, COBJ):
+  case TYPE_PAIR(FLNUM, COBJ):
+  case TYPE_PAIR(RNG, COBJ):
+    return do_binary_method(self, le_s, bnum, anum);
   }
 
   invalid_ops(self, anum, bnum);
@@ -1867,7 +2056,7 @@ tail:
 
 val le(val anum, val bnum)
 {
-  val self = lit("<=");
+  val self = le_s;
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
@@ -1915,6 +2104,19 @@ tail:
 
       return nil;
     }
+  case TYPE_PAIR(COBJ, NUM):
+  case TYPE_PAIR(COBJ, CHR):
+  case TYPE_PAIR(COBJ, BGNUM):
+  case TYPE_PAIR(COBJ, FLNUM):
+  case TYPE_PAIR(COBJ, RNG):
+  case TYPE_PAIR(COBJ, COBJ):
+    return do_binary_method(self, self, anum, bnum);
+  case TYPE_PAIR(NUM, COBJ):
+  case TYPE_PAIR(CHR, COBJ):
+  case TYPE_PAIR(BGNUM, COBJ):
+  case TYPE_PAIR(FLNUM, COBJ):
+  case TYPE_PAIR(RNG, COBJ):
+    return do_binary_method(self, ge_s, bnum, anum);
   }
 
   invalid_ops(self, anum, bnum);
@@ -1922,7 +2124,7 @@ tail:
 
 val numeq(val anum, val bnum)
 {
-  val self = lit("=");
+  val self = numeq_s;
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
   case TYPE_PAIR(NUM, NUM):
@@ -1955,6 +2157,19 @@ tail:
   case TYPE_PAIR(RNG, RNG):
     return and2(numeq(from(anum), from(bnum)),
                 numeq(to(anum), to(bnum)));
+  case TYPE_PAIR(COBJ, NUM):
+  case TYPE_PAIR(COBJ, CHR):
+  case TYPE_PAIR(COBJ, BGNUM):
+  case TYPE_PAIR(COBJ, FLNUM):
+  case TYPE_PAIR(COBJ, RNG):
+  case TYPE_PAIR(COBJ, COBJ):
+    return do_binary_method(self, self, anum, bnum);
+  case TYPE_PAIR(NUM, COBJ):
+  case TYPE_PAIR(CHR, COBJ):
+  case TYPE_PAIR(BGNUM, COBJ):
+  case TYPE_PAIR(FLNUM, COBJ):
+  case TYPE_PAIR(RNG, COBJ):
+    return do_binary_method(self, self, bnum, anum);
   }
 
   invalid_ops(self, anum, bnum);
@@ -1962,7 +2177,7 @@ tail:
 
 val expt(val anum, val bnum)
 {
-  val self = lit("expt");
+  val self = expt_s;
 
 tail:
   switch (TYPE_PAIR(type(anum), type(bnum))) {
@@ -2100,6 +2315,19 @@ tail:
   case TYPE_PAIR(FLNUM, BGNUM):
     bnum = flo_int(bnum);
     goto tail;
+  case TYPE_PAIR(COBJ, NUM):
+  case TYPE_PAIR(COBJ, CHR):
+  case TYPE_PAIR(COBJ, BGNUM):
+  case TYPE_PAIR(COBJ, FLNUM):
+  case TYPE_PAIR(COBJ, RNG):
+  case TYPE_PAIR(COBJ, COBJ):
+    return do_binary_method(self, self, anum, bnum);
+  case TYPE_PAIR(NUM, COBJ):
+  case TYPE_PAIR(CHR, COBJ):
+  case TYPE_PAIR(BGNUM, COBJ):
+  case TYPE_PAIR(FLNUM, COBJ):
+  case TYPE_PAIR(RNG, COBJ):
+    return do_binary_method(self, r_expt_s, bnum, anum);
   }
 
   invalid_ops(self, anum, bnum);
@@ -2109,7 +2337,7 @@ divzero:
 
 val exptmod(val base, val exp, val mod)
 {
-  val self = lit("exptmod");
+  val self = exptmod_s;
   mp_err mpe = MP_OKAY;
   val n;
 
@@ -2131,7 +2359,11 @@ val exptmod(val base, val exp, val mod)
     goto bad;
 
   return normalize(n);
+
 inval:
+  if (cobjp(base))
+    return do_ternary_method(self, self, base, exp, mod);
+
   uw_throwf(error_s, lit("~a: non-integral operands ~s ~s ~s"),
             self, base, exp, mod, nao);
 bad:
@@ -2154,6 +2386,8 @@ static int_ptr_t isqrt_fixnum(int_ptr_t a)
 
 val isqrt(val anum)
 {
+  val self = isqrt_s;
+
   switch (type(anum)) {
   case NUM:
     {
@@ -2169,18 +2403,20 @@ val isqrt(val anum)
         goto negop;
       return normalize(n);
     }
+  case COBJ:
+    return do_unary_method(self, self, anum);
   default:
     break;
   }
 
-  uw_throwf(error_s, lit("isqrt: non-integer operand ~s"), anum, nao);
+  uw_throwf(error_s, lit("~s: non-integer operand ~s"), self, anum, nao);
 negop:
-  uw_throw(error_s, lit("isqrt: negative operand"));
+  uw_throwf(error_s, lit("~s: negative operand"), self, nao);
 }
 
 val square(val anum)
 {
-  val self = lit("square");
+  val self = square_s;
 
   switch (type(anum)) {
   case NUM:
@@ -2224,11 +2460,13 @@ val square(val anum)
     }
   case RNG:
     return rcons(square(from(anum)), square(to(anum)));
+  case COBJ:
+    return do_unary_method(self, self, anum);
   default:
     break;
   }
 
-  uw_throwf(error_s, lit("square: invalid operand ~s"), anum, nao);
+  uw_throwf(error_s, lit("~a: invalid operand ~s"), self, anum, nao);
 }
 
 val gcd(val anum, val bnum)
@@ -2309,6 +2547,8 @@ val floorf(val num)
     return flo(floor(c_flo(num, self)));
   case RNG:
     return rcons(floorf(from(num)), floorf(to(num)));
+  case COBJ:
+    return do_unary_method(self, floor1_s, num);
   default:
     break;
   }
@@ -2318,7 +2558,7 @@ val floorf(val num)
 
 val ceili(val num)
 {
-  val self = lit("ceil");
+  val self = ceil_s;
 
   switch (type(num)) {
   case NUM:
@@ -2328,6 +2568,8 @@ val ceili(val num)
     return flo(ceil(c_flo(num, self)));
   case RNG:
     return rcons(ceili(from(num)), ceili(to(num)));
+  case COBJ:
+    return do_unary_method(self, ceil1_s, num);
   default:
     break;
   }
@@ -2337,56 +2579,76 @@ val ceili(val num)
 
 val sine(val num)
 {
-  val self = lit("sin");
+  val self = sin_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(sin(c_flo(to_float(self, num), self)));
 }
 
 val cosi(val num)
 {
-  val self = lit("cos");
+  val self = cos_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(cos(c_flo(to_float(self, num), self)));
 }
 
 val tang(val num)
 {
-  val self = lit("tan");
+  val self = tan_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(tan(c_flo(to_float(self, num), self)));
 }
 
 val asine(val num)
 {
-  val self = lit("asin");
+  val self = asin_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(asin(c_flo(to_float(self, num), self)));
 }
 
 val acosi(val num)
 {
-  val self = lit("acos");
+  val self = acos_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(acos(c_flo(to_float(self, num), self)));
 }
 
 val atang(val num)
 {
-  val self = lit("atan");
+  val self = atan_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(atan(c_flo(to_float(self, num), self)));
 }
 
 val atang2(val y, val x)
 {
-  val self = lit("atan2");
+  val self = atan2_s;
+  if (cobjp(y))
+    return do_binary_method(self, self, y, x);
+  if (cobjp(x))
+    return do_binary_method(self, r_atan2_s, x, y);
   return flo(atan2(c_flo(to_float(self, y), self),
                    c_flo(to_float(self, x), self)));
 }
 
 val loga(val num)
 {
-  val self = lit("log");
+  val self = log_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(log(c_flo(to_float(self, num), self)));
 }
 
 val logten(val num)
 {
-  val self = lit("log10");
+  val self = log10_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(log10(c_flo(to_float(self, num), self)));
 }
 
@@ -2414,19 +2676,25 @@ static double log2(double x)
 
 val logtwo(val num)
 {
-  val self = lit("log2");
+  val self = log2_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(log2(c_flo(to_float(self, num), self)));
 }
 
 val expo(val num)
 {
-  val self = lit("exp");
+  val self = exp_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(exp(c_flo(to_float(self, num), self)));
 }
 
 val sqroot(val num)
 {
-  val self = lit("sqrt");
+  val self = sqrt_s;
+  if (cobjp(num))
+    return do_unary_method(self, self, num);
   return flo(sqrt(c_flo(to_float(self, num), self)));
 }
 
@@ -2513,6 +2781,7 @@ val flo_int(val i)
 
 val logand(val a, val b)
 {
+  val self = logand_s;
   val c;
 
   switch (TYPE_PAIR(type(a), type(b))) {
@@ -2546,16 +2815,24 @@ val logand(val a, val b)
     if (mp_and(mp(a), mp(b), mp(c)) != MP_OKAY)
       goto bad;
     return normalize(c);
+  case TYPE_PAIR(COBJ, NUM):
+  case TYPE_PAIR(COBJ, BGNUM):
+  case TYPE_PAIR(COBJ, COBJ):
+    return do_binary_method(self, self, a, b);
+  case TYPE_PAIR(NUM, COBJ):
+  case TYPE_PAIR(BGNUM, COBJ):
+    return do_binary_method(self, self, b, a);
   default:
-    uw_throwf(error_s, lit("logand: non-integral operands ~s ~s"), a, b, nao);
+    uw_throwf(error_s, lit("~a: non-integral operands ~s ~s"), self, a, b, nao);
   }
 
 bad:
-  uw_throwf(error_s, lit("logand: operation failed on ~s ~s"), a, b, nao);
+  uw_throwf(error_s, lit("~a: operation failed on ~s ~s"), self, a, b, nao);
 }
 
 val logior(val a, val b)
 {
+  val self = logior_s;
   val c;
 
   switch (TYPE_PAIR(type(a), type(b))) {
@@ -2589,16 +2866,24 @@ val logior(val a, val b)
     if (mp_or(mp(a), mp(b), mp(c)) != MP_OKAY)
       goto bad;
     return normalize(c);
+  case TYPE_PAIR(COBJ, NUM):
+  case TYPE_PAIR(COBJ, BGNUM):
+  case TYPE_PAIR(COBJ, COBJ):
+    return do_binary_method(self, self, a, b);
+  case TYPE_PAIR(NUM, COBJ):
+  case TYPE_PAIR(BGNUM, COBJ):
+    return do_binary_method(self, self, b, a);
   default:
-    uw_throwf(error_s, lit("logior: non-integral operands ~s ~s"), a, b, nao);
+    uw_throwf(error_s, lit("~a: non-integral operands ~s ~s"), self, a, b, nao);
   }
 
 bad:
-  uw_throwf(error_s, lit("logior: operation failed on ~s ~s"), a, b, nao);
+  uw_throwf(error_s, lit("~a: operation failed on ~s ~s"), self, a, b, nao);
 }
 
 val logxor(val a, val b)
 {
+  val self = logxor_s;
   val c;
 
   switch (TYPE_PAIR(type(a), type(b))) {
@@ -2632,12 +2917,19 @@ val logxor(val a, val b)
     if (mp_xor(mp(a), mp(b), mp(c)) != MP_OKAY)
       goto bad;
     return normalize(c);
+  case TYPE_PAIR(COBJ, NUM):
+  case TYPE_PAIR(COBJ, BGNUM):
+  case TYPE_PAIR(COBJ, COBJ):
+    return do_binary_method(self, self, a, b);
+  case TYPE_PAIR(NUM, COBJ):
+  case TYPE_PAIR(BGNUM, COBJ):
+    return do_binary_method(self, self, b, a);
   default:
-    uw_throwf(error_s, lit("logxor: non-integral operands ~s ~s"), a, b, nao);
+    uw_throwf(error_s, lit("~a: non-integral operands ~s ~s"), self, a, b, nao);
   }
 
 bad:
-  uw_throwf(error_s, lit("logxor: operation failed on ~s ~s"), a, b, nao);
+  uw_throwf(error_s, lit("~a: operation failed on ~s ~s"), self, a, b, nao);
 }
 
 val logxor_old(val a, val b)
@@ -2698,6 +2990,7 @@ val logtest(val a, val b)
 
 static val comp_trunc(val a, val bits)
 {
+  val self = lognot1_s;
   cnum an, bn;
   val b;
   const cnum num_mask = (NUM_MAX << 1) | 1;
@@ -2725,25 +3018,32 @@ static val comp_trunc(val a, val bits)
     if (mp_trunc_comp(mp(a), mp(b), bn) != MP_OKAY)
       goto bad;
     return normalize(b);
+  case COBJ:
+    return do_binary_method(self, lognot_s, a, bits);
   default:
     goto bad3;
   }
 
 bad:
-  uw_throwf(error_s, lit("lognot: operation failed on ~s"), a, nao);
+  uw_throwf(error_s, lit("~a: operation failed on ~s"), self, a, nao);
 
 bad2:
-  uw_throwf(error_s, lit("lognot: bits value ~s is not a fixnum"), bits, nao);
+  if (cobjp(a))
+    return do_binary_method(self, lognot_s, a, bits);
+  if (cobjp(bits))
+    return do_binary_method(self, r_lognot_s, bits, a);
+  uw_throwf(error_s, lit("~a: bits value ~s is not a fixnum"), bits, nao);
 
 bad3:
-  uw_throwf(error_s, lit("lognot: non-integral operand ~s"), a, nao);
+  uw_throwf(error_s, lit("~a: non-integral operand ~s"), self, a, nao);
 
 bad4:
-  uw_throwf(error_s, lit("lognot: negative bits value ~s"), bits, nao);
+  uw_throwf(error_s, lit("~a: negative bits value ~s"), self, bits, nao);
 }
 
 val lognot(val a, val bits)
 {
+  val self = lognot1_s;
   val b;
 
   if (default_null_arg(bits))
@@ -2757,17 +3057,19 @@ val lognot(val a, val bits)
     if (mp_comp(mp(a), mp(b)) != MP_OKAY)
       goto bad;
     return normalize(b);
+  case COBJ:
+    return do_unary_method(self, self, a);
   default:
-    uw_throwf(error_s, lit("lognot: non-integral operand ~s"), a, nao);
+    uw_throwf(error_s, lit("~a: non-integral operand ~s"), self, a, nao);
   }
 
 bad:
-  uw_throwf(error_s, lit("lognot: operation failed on ~s"), a, nao);
+  uw_throwf(error_s, lit("~a: operation failed on ~s"), self, a, nao);
 }
 
 val logtrunc(val a, val bits)
 {
-  val self = lit("logtrunc");
+  val self = logtrunc_s;
   cnum an, bn;
   val b;
   const cnum num_mask = (NUM_MAX << 1) | 1;
@@ -2796,11 +3098,17 @@ val logtrunc(val a, val bits)
     if ((mpe = mp_trunc(mp(a), mp(b), bn)) != MP_OKAY)
       do_mp_error(self, mpe);
     return normalize(b);
+  case COBJ:
+    return do_binary_method(self, r_logtrunc_s, bits, a);
   default:
     goto bad3;
   }
 
 bad2:
+  if (cobjp(a))
+    return do_binary_method(self, self, a, bits);
+  if (cobjp(bits))
+    return do_binary_method(self, r_logtrunc_s, bits, a);
   uw_throwf(error_s, lit("~a: bits value ~s is not a fixnum"), self, bits, nao);
 
 bad3:
@@ -2812,6 +3120,7 @@ bad4:;
 
 val sign_extend(val n, val nbits)
 {
+  val self = sign_extend_s;
   val msb = minus(nbits, one);
   val ntrunc = logtrunc(n, nbits);
 
@@ -2829,10 +3138,13 @@ val sign_extend(val n, val nbits)
         mp_err mpe;
         mp_2comp(mp(ntrunc), mp(out), mp(ntrunc)->used);
         if ((mpe = mp_trunc(mp(out), mp(out), c_n(nbits))) != MP_OKAY)
-          do_mp_error(lit("sign-extend"), mpe);
+          do_mp_error(self, mpe);
         mp_neg(mp(out), mp(out));
         return normalize(out);
       }
+    case COBJ:
+      ntrunc = do_binary_method(self, self, ntrunc, nbits);
+      break;
     default:
       internal_error("impossible case");
     }
@@ -2842,20 +3154,24 @@ val sign_extend(val n, val nbits)
 
 val ash(val a, val bits)
 {
-  val self = lit("ash");
+  val self = ash_s;
+  type_t ta = type(a);
   cnum an, bn;
   val b;
   int hb;
   const int num_bits = CHAR_BIT * sizeof (cnum) - TAG_SHIFT;
   mp_err mpe = MP_OKAY;
 
+  if (ta == COBJ)
+    return do_binary_method(self, self, a, bits);
+
   if (!fixnump(bits))
     goto bad2;
 
   bn = c_n(bits);
 
   if (bn == 0) {
-    switch (type(a)) {
+    switch (ta) {
     case NUM:
     case BGNUM:
       return a;
@@ -2863,7 +3179,7 @@ val ash(val a, val bits)
       goto bad3;
     }
   } else if (bn > 0) {
-    switch (type(a)) {
+    switch (ta) {
     case NUM:
       an = c_n(a);
       hb = highest_significant_bit(an);
@@ -2882,7 +3198,7 @@ val ash(val a, val bits)
       goto bad3;
     }
   } else {
-    switch (type(a)) {
+    switch (ta) {
     case NUM:
       bn = -bn;
       an = c_n(a);
@@ -2913,10 +3229,14 @@ bad4:
 
 val bit(val a, val bit)
 {
-  val self = lit("bit");
+  val self = bit_s;
+  type_t ta = type(a);
   cnum bn;
   mp_err mpe = MP_OKAY;
 
+  if (ta == COBJ)
+    return do_binary_method(self, self, a, bit);
+
   if (!fixnump(bit))
     goto bad;
 
@@ -2925,7 +3245,7 @@ val bit(val a, val bit)
   if (bn < 0)
     goto bad2;
 
-  switch (type(a)) {
+  switch (ta) {
   case NUM:
   case CHR:
     {
@@ -2980,7 +3300,7 @@ val maskv(struct args *bits)
 
 val logcount(val n)
 {
-  val self = lit("logcount");
+  val self = logcount_s;
 
   switch (type(n)) {
   case NUM:
@@ -3015,6 +3335,8 @@ val logcount(val n)
         internal_error("problem in bignum arithmetic");
       return unum(co);
     }
+  case COBJ:
+    return do_unary_method(self, self, n);
   default:
     uw_throwf(error_s, lit("~a: non-integral operand ~s"), self, n, nao);
   }
@@ -3230,9 +3552,11 @@ val tointz(val obj, val base)
 
 val width(val obj)
 {
-  switch (tag(obj)) {
-  case TAG_NUM:
-  case TAG_CHR:
+  val self = width_s;
+
+  switch (type(obj)) {
+  case CHR:
+  case NUM:
     {
       cnum n = c_n(obj);
 
@@ -3243,8 +3567,8 @@ val width(val obj)
       }
       return num_fast(highest_bit(n));
     }
-  case TAG_PTR:
-    if (type(obj) == BGNUM) {
+  case BGNUM:
+    {
       mp_size count;
       if (mp_cmp_z(mp(obj)) == MP_LT) {
         mp_int tmp;
@@ -3262,10 +3586,12 @@ val width(val obj)
       }
       return unum(count);
     }
+  case COBJ:
+    return do_unary_method(self, self, obj);
   default:
     break;
   }
-  uw_throwf(error_s, lit("width: ~s isn't an integer"), obj, nao);
+  uw_throwf(error_s, lit("~a: ~s isn't an integer"), self, obj, nao);
 }
 
 val bits(val obj)
@@ -3600,9 +3926,15 @@ val nary_simple_op(val self, val (*bfun)(val, val),
 
 static val unary_num(val self, val arg)
 {
-  if (!numberp(arg))
+  switch (type(arg)) {
+  case NUM:
+  case BGNUM:
+  case FLNUM:
+  case COBJ:
+    return arg;
+  default:
     uw_throwf(error_s, lit("~a: ~s isn't a number"), self, arg, nao);
-  return arg;
+  }
 }
 
 static val unary_arith(val self, val arg)
@@ -3612,6 +3944,7 @@ static val unary_arith(val self, val arg)
   case CHR:
   case BGNUM:
   case FLNUM:
+  case COBJ:
     return arg;
   default:
     uw_throwf(error_s, lit("~a: invalid argument ~s"), self, arg, nao);
@@ -3627,7 +3960,7 @@ static val unary_int(val self, val arg)
 
 val plusv(struct args *nlist)
 {
-  return nary_op(lit("+"), plus, unary_arith, nlist, zero);
+  return nary_op(plus_s, plus, unary_arith, nlist, zero);
 }
 
 val minusv(val minuend, struct args *nlist)
@@ -3648,7 +3981,7 @@ val minusv(val minuend, struct args *nlist)
 
 val mulv(struct args *nlist)
 {
-  return nary_op(lit("*"), mul, unary_num, nlist, one);
+  return nary_op(mul_s, mul, unary_num, nlist, one);
 }
 
 val divv(val dividend, struct args *nlist)
@@ -3669,12 +4002,12 @@ val divv(val dividend, struct args *nlist)
 
 val logandv(struct args *nlist)
 {
-  return nary_op(lit("logand"), logand, unary_int, nlist, negone);
+  return nary_op(logand_s, logand, unary_int, nlist, negone);
 }
 
 val logiorv(struct args *nlist)
 {
-  return nary_op(lit("logior"), logior, unary_int, nlist, zero);
+  return nary_op(logior_s, logior, unary_int, nlist, zero);
 }
 
 val gtv(val first, struct args *rest)
@@ -3689,7 +4022,7 @@ val gtv(val first, struct args *rest)
   }
 
   if (index == 0)
-    (void) unary_arith(lit(">"), first);
+    (void) unary_arith(gt_s, first);
 
   return t;
 }
@@ -3706,7 +4039,7 @@ val ltv(val first, struct args *rest)
   }
 
   if (index == 0)
-    (void) unary_arith(lit("<"), first);
+    (void) unary_arith(lt_s, first);
 
   return t;
 }
@@ -3723,7 +4056,7 @@ val gev(val first, struct args *rest)
   }
 
   if (index == 0)
-    (void) unary_arith(lit(">="), first);
+    (void) unary_arith(ge_s, first);
 
   return t;
 }
@@ -3740,7 +4073,7 @@ val lev(val first, struct args *rest)
   }
 
   if (index == 0)
-    (void) unary_arith(lit("<="), first);
+    (void) unary_arith(le_s, first);
 
   return t;
 }
@@ -3757,7 +4090,7 @@ val numeqv(val first, struct args *rest)
   }
 
   if (index == 0)
-    (void) unary_arith(lit("="), first);
+    (void) unary_arith(numeq_s, first);
 
   return t;
 }
@@ -3782,7 +4115,7 @@ val numneqv(struct args *args)
 
 static val sumv(struct args *nlist, val keyfun)
 {
-  return nary_op_keyfun(lit("+"), plus, unary_arith, nlist, zero, keyfun);
+  return nary_op_keyfun(plus_s, plus, unary_arith, nlist, zero, keyfun);
 }
 
 val sum(val seq, val keyfun)
@@ -3793,7 +4126,7 @@ val sum(val seq, val keyfun)
 
 static val prodv(struct args *nlist, val keyfun)
 {
-  return nary_op_keyfun(lit("*"), mul, unary_num, nlist, one, keyfun);
+  return nary_op_keyfun(mul_s, mul, unary_num, nlist, one, keyfun);
 }
 
 val prod(val seq, val keyfun)
@@ -3812,7 +4145,7 @@ 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);
+  return nary_op(expt_s, rexpt, unary_num, rnlist, one);
 }
 
 static val abso_self(val self, val arg)
@@ -3836,6 +4169,70 @@ void arith_init(void)
 {
   log2_init();
 
+  plus_s = intern(lit("+"), user_package);
+  minus_s = intern(lit("-"), user_package);
+  inv_minus_s = intern(lit("--"), user_package);
+  neg_s = intern(lit("neg"), user_package);
+  abs_s = intern(lit("abs"), user_package);
+  signum_s = intern(lit("signum"), user_package);
+  mul_s = intern(lit("*"), user_package);
+  div_s = intern(lit("/"), user_package);
+  recip_s = intern(lit("recip"), user_package);
+  inv_div_s = intern(lit("//"), user_package);
+  trunc1_s = intern(lit("trunc1"), user_package);
+  trunc_s = intern(lit("trunc"), user_package);
+  r_trunc_s = intern(lit("r-trunc"), user_package);
+  mod_s = intern(lit("mod"), user_package);
+  r_mod_s = intern(lit("r-mod"), user_package);
+  zerop_s = intern(lit("zerop"), user_package);
+  plusp_s = intern(lit("plusp"), user_package);
+  minusp_s = intern(lit("minusp"), user_package);
+  evenp_s = intern(lit("evenp"), user_package);
+  oddp_s = intern(lit("oddp"), user_package);
+  gt_s = intern(lit(">"), user_package);
+  lt_s = intern(lit("<"), user_package);
+  ge_s = intern(lit(">="), user_package);
+  le_s = intern(lit("<="), user_package);
+  numeq_s = intern(lit("="), user_package);
+  expt_s = intern(lit("expt"), user_package);
+  r_expt_s = intern(lit("r-expt"), user_package);
+  exptmod_s = intern(lit("exptmod"), user_package);
+  isqrt_s = intern(lit("isqrt"), user_package);
+  square_s = intern(lit("square"), user_package);
+  floor_s = intern(lit("floor"), user_package);
+  floor1_s = intern(lit("floor1"), user_package);
+  r_floor_s = intern(lit("r-floor"), user_package);
+  ceil_s = intern(lit("ceil"), user_package);
+  ceil1_s = intern(lit("ceil1"), user_package);
+  round_s = intern(lit("round"), user_package);
+  round1_s = intern(lit("round1"), user_package);
+  sin_s = intern(lit("sin"), user_package);
+  cos_s = intern(lit("cos"), user_package);
+  tan_s = intern(lit("tan"), user_package);
+  asin_s = intern(lit("asin"), user_package);
+  acos_s = intern(lit("acos"), user_package);
+  atan_s = intern(lit("atan"), user_package);
+  atan2_s = intern(lit("atan2"), user_package);
+  r_atan2_s = intern(lit("r-atan2"), user_package);
+  log_s = intern(lit("log"), user_package);
+  log2_s = intern(lit("log2"), user_package);
+  log10_s = intern(lit("log10"), user_package);
+  exp_s = intern(lit("exp"), user_package);
+  sqrt_s = intern(lit("sqrt"), user_package);
+  logand_s = intern(lit("logand"), user_package);
+  logior_s = intern(lit("logior"), user_package);
+  logxor_s = intern(lit("logxor"), user_package);
+  lognot1_s = intern(lit("lognot1"), user_package);
+  lognot_s = intern(lit("lognot"), user_package);
+  r_lognot_s = intern(lit("r-logtruncnot"), user_package);
+  logtrunc_s = intern(lit("logtrunc"), user_package);
+  r_logtrunc_s = intern(lit("r-logtrunc"), user_package);
+  sign_extend_s = intern(lit("sign-extend"), user_package);
+  ash_s = intern(lit("ash"), user_package);
+  bit_s = intern(lit("bit"), user_package);
+  width_s = intern(lit("width"), user_package);
+  logcount_s = intern(lit("logcount"), user_package);
+
   if (opt_compat && opt_compat <= 199) {
     reg_varl(intern(lit("*flo-dig*"), user_package), num_fast(DBL_DIG));
     reg_varl(intern(lit("*flo-max*"), user_package), flo(DBL_MAX));
@@ -3865,73 +4262,73 @@ void arith_init(void)
     reg_varl(intern(lit("*e*"), user_package), flo(M_E));
   }
 
-  reg_fun(plus_s = intern(lit("+"), user_package), func_n0v(plusv));
-  reg_fun(intern(lit("-"), user_package), func_n1v(minusv));
-  reg_fun(intern(lit("*"), user_package), func_n0v(mulv));
+  reg_fun(plus_s, func_n0v(plusv));
+  reg_fun(minus_s, func_n1v(minusv));
+  reg_fun(mul_s, func_n0v(mulv));
   reg_fun(intern(lit("sum"), user_package), func_n2o(sum, 1));
   reg_fun(intern(lit("prod"), user_package), func_n2o(prod, 1));
-  reg_fun(intern(lit("abs"), user_package), func_n1(abso));
-  reg_fun(intern(lit("trunc"), user_package), func_n2o(trunc, 1));
-  reg_fun(intern(lit("mod"), user_package), func_n2(mod));
-  reg_fun(intern(lit("zerop"), user_package), func_n1(zerop));
+  reg_fun(abs_s, func_n1(abso));
+  reg_fun(trunc_s, func_n2o(trunc, 1));
+  reg_fun(mod_s, func_n2(mod));
+  reg_fun(zerop_s, func_n1(zerop));
   reg_fun(intern(lit("nzerop"), user_package), func_n1(nzerop));
-  reg_fun(intern(lit("plusp"), user_package), func_n1(plusp));
-  reg_fun(intern(lit("minusp"), user_package), func_n1(minusp));
-  reg_fun(intern(lit("evenp"), user_package), func_n1(evenp));
-  reg_fun(intern(lit("oddp"), user_package), func_n1(oddp));
+  reg_fun(plusp_s, func_n1(plusp));
+  reg_fun(minusp_s, func_n1(minusp));
+  reg_fun(evenp_s, func_n1(evenp));
+  reg_fun(oddp_s, func_n1(oddp));
   reg_fun(intern(lit("succ"), user_package), func_n1(succ));
   reg_fun(intern(lit("ssucc"), user_package), func_n1(ssucc));
   reg_fun(intern(lit("sssucc"), user_package), func_n1(sssucc));
   reg_fun(intern(lit("pred"), user_package), func_n1(pred));
   reg_fun(intern(lit("ppred"), user_package), func_n1(ppred));
   reg_fun(intern(lit("pppred"), user_package), func_n1(pppred));
-  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));
-  reg_fun(intern(lit("<="), user_package), func_n1v(lev));
-  reg_fun(intern(lit("="), user_package), func_n1v(numeqv));
+  reg_fun(gt_s, func_n1v(gtv));
+  reg_fun(lt_s, func_n1v(ltv));
+  reg_fun(ge_s, func_n1v(gev));
+  reg_fun(le_s, func_n1v(lev));
+  reg_fun(numeq_s, func_n1v(numeqv));
   reg_fun(intern(lit("/="), user_package), func_n0v(numneqv));
   reg_fun(intern(lit("wrap"), user_package), func_n3(wrap));
   reg_fun(intern(lit("wrap*"), user_package), func_n3(wrap_star));
-  reg_fun(intern(lit("/"), user_package), func_n1v(divv));
-  reg_fun(intern(lit("expt"), user_package), func_n0v(exptv));
-  reg_fun(intern(lit("exptmod"), user_package), func_n3(exptmod));
-  reg_fun(intern(lit("isqrt"), user_package), func_n1(isqrt));
-  reg_fun(intern(lit("square"), user_package), func_n1(square));
+  reg_fun(div_s, func_n1v(divv));
+  reg_fun(expt_s, func_n0v(exptv));
+  reg_fun(exptmod_s, func_n3(exptmod));
+  reg_fun(isqrt_s, func_n1(isqrt));
+  reg_fun(square_s, func_n1(square));
   reg_fun(intern(lit("gcd"), user_package), func_n0v(gcdv));
   reg_fun(intern(lit("lcm"), user_package), func_n0v(lcmv));
-  reg_fun(intern(lit("floor"), user_package), func_n2o(floordiv, 1));
-  reg_fun(intern(lit("ceil"), user_package), func_n2o(ceildiv, 1));
-  reg_fun(intern(lit("round"), user_package), func_n2o(roundiv, 1));
+  reg_fun(floor_s, func_n2o(floordiv, 1));
+  reg_fun(ceil_s, func_n2o(ceildiv, 1));
+  reg_fun(round_s, func_n2o(roundiv, 1));
   reg_fun(intern(lit("trunc-rem"), user_package), func_n2o(trunc_rem, 1));
   reg_fun(intern(lit("floor-rem"), user_package), func_n2o(floor_rem, 1));
   reg_fun(intern(lit("ceil-rem"), user_package), func_n2o(ceil_rem, 1));
   reg_fun(intern(lit("round-rem"), user_package), func_n2o(round_rem, 1));
-  reg_fun(intern(lit("sin"), user_package), func_n1(sine));
-  reg_fun(intern(lit("cos"), user_package), func_n1(cosi));
-  reg_fun(intern(lit("tan"), user_package), func_n1(tang));
-  reg_fun(intern(lit("asin"), user_package), func_n1(asine));
-  reg_fun(intern(lit("acos"), user_package), func_n1(acosi));
-  reg_fun(intern(lit("atan"), user_package), func_n1(atang));
-  reg_fun(intern(lit("atan2"), user_package), func_n2(atang2));
-  reg_fun(intern(lit("log"), user_package), func_n1(loga));
-  reg_fun(intern(lit("log10"), user_package), func_n1(logten));
-  reg_fun(intern(lit("log2"), user_package), func_n1(logtwo));
-  reg_fun(intern(lit("exp"), user_package), func_n1(expo));
-  reg_fun(intern(lit("sqrt"), user_package), func_n1(sqroot));
-  reg_fun(intern(lit("logand"), user_package), func_n0v(logandv));
-  reg_fun(intern(lit("logior"), user_package), func_n0v(logiorv));
-  reg_fun(intern(lit("logxor"), user_package),
+  reg_fun(sin_s, func_n1(sine));
+  reg_fun(cos_s, func_n1(cosi));
+  reg_fun(tan_s, func_n1(tang));
+  reg_fun(asin_s, func_n1(asine));
+  reg_fun(acos_s, func_n1(acosi));
+  reg_fun(atan_s, func_n1(atang));
+  reg_fun(atan2_s, func_n2(atang2));
+  reg_fun(log_s, func_n1(loga));
+  reg_fun(log10_s, func_n1(logten));
+  reg_fun(log2_s, func_n1(logtwo));
+  reg_fun(exp_s, func_n1(expo));
+  reg_fun(sqrt_s, func_n1(sqroot));
+  reg_fun(logand_s, func_n0v(logandv));
+  reg_fun(logior_s, func_n0v(logiorv));
+  reg_fun(logxor_s,
           func_n2(if3(opt_compat && opt_compat <= 202, logxor_old, logxor)));
   reg_fun(intern(lit("logtest"), user_package), func_n2(logtest));
-  reg_fun(intern(lit("lognot"), user_package), func_n2o(lognot, 1));
-  reg_fun(intern(lit("logtrunc"), user_package), func_n2(logtrunc));
-  reg_fun(intern(lit("sign-extend"), user_package), func_n2(sign_extend));
-  reg_fun(intern(lit("ash"), user_package), func_n2(ash));
-  reg_fun(intern(lit("bit"), user_package), func_n2(bit));
+  reg_fun(lognot_s, func_n2o(lognot, 1));
+  reg_fun(logtrunc_s, func_n2(logtrunc));
+  reg_fun(sign_extend_s, func_n2(sign_extend));
+  reg_fun(ash_s, func_n2(ash));
+  reg_fun(bit_s, func_n2(bit));
   reg_fun(intern(lit("mask"), user_package), func_n0v(maskv));
-  reg_fun(intern(lit("width"), user_package), func_n1(width));
-  reg_fun(intern(lit("logcount"), user_package), func_n1(logcount));
+  reg_fun(width_s, func_n1(width));
+  reg_fun(logcount_s, func_n1(logcount));
   reg_fun(intern(lit("cum-norm-dist"), user_package), func_n1(cum_norm_dist));
   reg_fun(intern(lit("inv-cum-norm"), user_package), func_n1(inv_cum_norm));
   reg_fun(intern(lit("n-choose-k"), user_package), func_n2(n_choose_k));
@@ -3943,7 +4340,7 @@ void arith_init(void)
   reg_fun(intern(lit("numberp"), user_package), func_n1(numberp));
 
 
-  reg_fun(intern(lit("signum"), user_package), func_n1(signum));
+  reg_fun(signum_s, 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));
@@ -3962,7 +4359,7 @@ void arith_init(void)
   reg_fun(intern(lit("b-"), system_package), func_n2(minus));
   reg_fun(intern(lit("b*"), system_package), func_n2(mul));
   reg_fun(intern(lit("b/"), system_package), func_n2(divi));
-  reg_fun(intern(lit("neg"), system_package), func_n1(neg));
+  reg_fun(neg_s, func_n1(neg));
 
 #if HAVE_ROUNDING_CTL_H
   reg_varl(intern(lit("flo-near"), user_package), num(FE_TONEAREST));
diff --git a/txr.1 b/txr.1
index f2af3da2..377584c0 100644
--- a/txr.1
+++ b/txr.1
@@ -37798,6 +37798,515 @@ is zero, the value returned is zero.
 
 The argument may be a character.
 
+.SS* User-Defined Arithmetic Types
+
+\*(TL makes it possible for the user application program to define structure
+types which can participate in arithmetic operations as if they were numbers.
+Under most arithmetic functions, a structure object may be used instead of a
+number, if that structure object implements a specific method which is required
+by that arithmetic function.
+
+The following paragraphs give general remarks about the method conventions.
+Not all arithmetic and bit manipulation functions have a corresponding
+method, and a small number of functions do not follow these conventions.
+
+In the simplest case of arithmetic functions which are unary, the method
+takes no argument other than the object itself. Most unary arithmetic functions
+expect a structure argument to have a method which has the same name as that
+function. For instance, if
+.code x
+is a structure, then
+.code "(cos x)"
+will invoke
+.codn "x.(cos)" .
+If
+.code x
+has no
+.code cos
+method, then an
+.code error
+exception is thrown. A few unary methods are not named after the corresponding function.
+The unary case of the
+.code -
+function excepts an object to have a method named
+.codn neg ;
+thus,
+.code "(- x)"
+invokes
+.codn "x.(neg)" .
+Unary division requires a method called
+.codn recip ;
+thus,
+.codn "(/ x)" ,
+invokes
+.codn "x.(recip)" .
+
+When a structure object is used as an argument in a two-argument (binary)
+arithmetic function, there are several cases to consider. If the left argument
+to a binary function is an object, then that object is expected to support a
+binary method. That method is called with two arguments: the object itself, of
+course, and the right argument of the arithmetic operation.  In this case, the
+method is named after the function. For instance, if
+.code x
+is an object, then
+.code "(+ x 3)"
+invokes
+.codn "x.(+ 3)" .
+If the right argument, and only the right argument, of a binary operation is an
+object, then the situation falls into two cases depending on whether the operation
+is commutative. If the operation is commutative, then the same method is used
+as in the case when the object is the left argument. The arguments are merely reversed.
+Thus
+.code "(+ 3 x)"
+also invokes
+.codn "x.(+ 3)" .
+If the operation is not commutative, then the object must supply an alternative
+method. For most functions, that method is named by a symbol whose name begins
+with a
+.code r-
+prefix.  For instance
+.code "(mod x 5)"
+invokes
+.code "x.(mod 5)"
+whereas
+.code "(mod 5 x)"
+invokes
+.codn "x.(r-mod 5)" .
+Note: the "r" may be remembered as indicating that the object is the
+.B right
+argument
+of the binary operation or that the arguments are
+.BR reversed .
+Two functions do not follow the
+.code r-
+convention. These are
+.code -
+and
+.codn / .
+For these, the methods used for the object as a right argument, respectively, are
+.code --
+and
+.codn // .
+Thus
+.code "(/ 5 x)"
+invokes
+.code "x.(// 5)"
+and
+.code "(- 5 x)"
+invokes
+.codn "x.(-- 5)" .
+Several binary functions do not support an object as the right argument. These are
+.codn sign-extend ,
+.code ash
+and
+.codn bit .
+
+Variadic arithmetic functions, when given three or more arguments, are regarded
+as performing a left-associative decimation of the arguments through a binary
+function. Thus for instance
+.code "(- 1 x 4)"
+is understood as
+.code "(- (- 1 x) 4)"
+where
+.code "x.(-- 1)"
+is evaluated first. If that method yields an object
+.code o
+then
+.code "o.(- 4)"
+is invoked.
+
+Certain variadic arithmetic functions, if invoked with one argument, just
+return that argument: for instance,
+.code +
+and
+.code *
+are in this category. A special concession exists in these functions: if
+their one and only argument is a structure, then that structure is returned
+without any error checking, even if it implements no methods related
+to arithmetic.
+
+The following sections describe each of the methods that must be implemented
+by an object for the associated arithmetic function to work with that object,
+either at all, or in a specific argument position, as the case may be.
+These methods are not provided by \*(TL; the application is required to provide
+them.
+
+.de bmc
+.  coNP Method @ \\$1
+.  synb
+.  mets << obj .(\\$1 << arg )
+.  syne
+.  desc
+The
+.  code \\$1
+method is invoked when a structure is used as an argument to the
+.  code \\$1
+function.
+
+If an object
+.  meta obj
+is combined with an argument
+.  metn arg ,
+either as
+.  cblk
+.  meti (\\$1 < obj << arg )
+.  cble
+or as
+.  cblk
+.  meti (\\$1 < arg << obj )
+.  cble
+then, effectively, the method call
+.  cblk
+.  meti << obj .(\\$1 << arg )
+.  cble
+takes place, and its return value is taken as the result
+of the operation.
+..
+
+.de bmcv
+.  coNP Method @ \\$1
+.  synb
+.  mets << obj .(\\$1 << arg )
+.  syne
+.  desc
+The
+.  code \\$1
+method is invoked when a structure is used as an argument to the
+.  code \\$1
+function together with at least one other operand.
+
+If an object
+.  meta obj
+is combined with an argument
+.  metn arg ,
+either as
+.  cblk
+.  meti (\\$1 < obj << arg )
+.  cble
+or as
+.  cblk
+.  meti (\\$1 < arg << obj )
+.  cble
+then, effectively, the method call
+.  cblk
+.  meti << obj .(\\$1 << arg )
+.  cble
+takes place, and its return value is taken as the result
+of the operation.
+..
+
+.de bmnl
+.  coNP Method @ \\$1
+.  synb
+.  mets << obj .(\\$1 << arg )
+.  syne
+.  desc
+The
+.  code \\$1
+method is invoked when the structure
+.  meta obj
+is used as the left argument of the
+.  code \\$1
+function.
+
+If an object
+.  meta obj
+is combined with an argument
+.  metn arg ,
+as
+.  cblk
+.  meti (\\$1 < obj << arg )
+.  cble
+then, effectively, the method call
+.  cblk
+.  meti << obj .(\\$1 << arg )
+.  cble
+takes place, and its return value is taken as the result
+of the operation.
+..
+
+.de bmnr
+.  coNP Method @ \\$1
+.  synb
+.  mets << obj .(\\$1 << arg )
+.  syne
+.  desc
+The
+.  code \\$1
+method is invoked when the structure
+.  meta obj
+is used as the right argument of the
+.  code \\$2
+function.
+
+If an object
+.  meta obj
+is combined with an argument
+.  metn arg ,
+as
+.  cblk
+.  meti (\\$2 < arg << obj )
+.  cble
+then, effectively, the method call
+.  cblk
+.  meti << obj .(\\$1 << arg )
+.  cble
+takes place, and its return value is taken as the result
+of the operation.
+..
+
+.de umv
+.  coNP Method @ \\$1
+.  synb
+.  mets << obj .(\\$1)
+.  syne
+.  desc
+The
+.  code \\$1
+method is invoked when the structure
+.  meta obj
+is used as the sole argument to the
+.  code \\$2
+function.
+
+If an object
+.  meta obj
+is passed to the function as
+.  cblk
+.  meti (\\$2 << obj )
+.  cble
+then, effectively, the method call
+.  cblk
+.  meti << obj .(\\$1)
+.  cble
+takes place, and its return value is taken as the result
+of the operation.
+..
+
+.de bma
+.  coNP Method @ \\$1
+.  synb
+.  mets << obj .(\\$1 << arg )
+.  syne
+.  desc
+The
+.  code \\$1
+method is invoked when the
+.  code \\$1
+function is invoked with two operands, and the structure
+.  meta obj
+is the left operand.
+The method is also invoked when the
+.  code \\$2
+function is invoked with two operands, and
+.meta obj
+is the right operand.
+
+If an object
+.  meta obj
+is combined with an argument
+.  metn arg ,
+either as
+.  cblk
+.  meti (\\$1 < obj << arg )
+.  cble
+or as
+.  cblk
+.  meti (\\$2 < arg << obj )
+.  cble
+then, effectively, the method call
+.  cblk
+.  meti << obj .(\\$1 << arg )
+.  cble
+takes place, and its return value is taken as the result
+of the operation.
+..
+
+.de um
+.  coNP Method @ \\$1
+.  synb
+.  mets << obj .(\\$1)
+.  syne
+.  desc
+The
+.  code \\$1
+method is invoked when a structure is used as the argument to the
+.  code \\$1
+function.
+
+If an object
+.  meta obj
+is passed to the function as
+.  cblk
+.  meti (\\$1 << obj )
+.  cble
+then, effectively, the method call
+.  cblk
+.  meti << obj .(\\$1)
+.  cble
+takes place, and its return value is taken as the result
+of the operation.
+..
+
+.de tmnl
+.  coNP Method @ \\$1
+.  synb
+.  mets << obj .(\\$1 < arg1 << arg2 )
+.  syne
+.  desc
+The
+.  code \\$1
+method is invoked when the structure
+.  meta obj
+is used as the left argument of the
+.  code \\$1
+function.
+
+If an object
+.  meta obj
+is combined with arguments
+.  meta arg1
+and
+.  metn arg2 ,
+as
+.  cblk
+.  meti (\\$1 < obj < arg1 << arg2 )
+.  cble
+then, effectively, the method call
+.  cblk
+.  meti << obj .(\\$1 < arg1 << arg2 )
+.  cble
+takes place, and its return value is taken as the result
+of the operation.
+..
+
+.bmcv +
+.bmnl -
+.bmnr -- -
+.umv neg -
+.bmcv *
+.bmnl /
+.bmnr // /
+.umv recip /
+.um abs
+.um signum
+.bmnl trunc
+.bmnr r-trunc trunc
+.umv trunc1 trunc
+.bmnl mod
+.bmnr r-mod mod
+.bmnl expt
+.bmnr r-expt expt
+.tmnl exptmod
+
+Note: the
+.code exptmod
+function doesn't support structure objects in the second and
+third argument positions. The
+.meta exponent
+and
+.meta base
+arguments must be integers.
+
+.um isqrt
+.um square
+.bma > <
+.bma < >
+.bma >= <=
+.bma <= >=
+.bmc =
+.um zerop
+.um plusp
+.um minusp
+.um evenp
+.um oddp
+.bmnl floor
+.bmnr r-floor floor
+.umv floor1 floor
+.umv ceil1 ceil
+
+Note: the two-argument version of the
+.code ceil
+function is internally defined in terms of unary
+.code -
+and
+.codn floor .
+Therefore, there is no
+.code ceil
+method required for supporting structure arguments to the
+.code ceil
+function; however, the
+.code neg
+and
+.code floor
+methods are required.
+
+.umv round
+
+Note: the two-argument version of the
+.code round
+function is internally defined in terms of
+.codn floor ,
+.codn - ,
+.codn + ,
+.codn * ,
+.code <
+and
+.codn minusp .
+Therefore, there is no
+.code round
+method required for supporting structure arguments to the
+.code round
+function; however, the methods corresponding to the
+above functions are required.
+
+.um sin
+.um cos
+.um tan
+.um asin
+.um acos
+.um atan
+.bmnl atan
+.bmnr r-atan atan
+.um log
+.um log2
+.um log10
+.um exp
+.um sqrt
+.bmcv logand
+.bmcv logior
+.bmnl lognot
+.bmnr lognot-r lognot
+.umv lognot1 lognot
+.bmnl logtrunc
+.bmnr r-logtrunc logtrunc
+.bmnl sign-extend
+
+Note: the
+.code sign-extend
+function doesn't support a structure as the right argument,
+.metn bits ,
+which must be an integer.
+
+.bmnl ash
+
+Note: the
+.code ash
+function doesn't support a structure as the right argument,
+.metn bits ,
+which must be an integer.
+
+.bmnl bit
+
+Note: the
+.code bit
+function doesn't support a structure as the right argument,
+.metn bit ,
+which must be an integer.
+
+.um width
+.um logcount
+
 .SS* Exception Handling
 
 An