u-d-arithmetic: proper treatment of ceil & round.

* arith.c (r_ceil_s, r_round_s): New symbol variables.
(ceildiv, roundiv): Route binary cases involving struts
directly to binary methods so the object is responsible for
the complete implementation.
(arith_init): Initialize r_ceil_s and r_round_s.

* tests/016/ud-arith.tl (numbase): Binary methods added for
ceil and round. Test cases added.

* txr.1: Descriptions for binary ceil and round methods added;
Notes about non-existence of binary methods removed from unary
ceil and round removed.

3 files changed, 35 insertions, 40 deletions

diff --git a/arith.c b/arith.c
index aa00a2da..c8ec84de 100644
--- a/arith.c
+++ b/arith.c
@@ -65,7 +65,8 @@ 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 ceil_s, ceil1_s, r_ceil_s;
+val round_s, round1_s, r_round_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;
@@ -1575,8 +1576,13 @@ divzero:
 
 val ceildiv(val anum, val bnum)
 {
+  val self = ceil_s;
   if (missingp(bnum))
     return ceili(anum);
+  if (type(anum) == COBJ)
+    return do_binary_method(self, self, anum, bnum);
+  if (type(bnum) == COBJ)
+    return do_binary_method(self, r_ceil_s, bnum, anum);
   return neg(floordiv(neg(anum), bnum));
 }
 
@@ -1611,18 +1617,28 @@ static val round1(val self, val num)
 val roundiv(val anum, val bnum)
 {
   val self = round_s;
+  type_t ta, tb;
 
   if (missingp(bnum))
     return round1(self, anum);
 
+  ta = type(anum);
+  tb = type(bnum);
+
+  if (ta == COBJ)
+    return do_binary_method(self, self, anum, bnum);
+
+  if (tb == COBJ)
+    return do_binary_method(self, r_round_s, bnum, anum);
+
   if (minusp(bnum)) {
     anum = neg(anum);
     bnum = neg(bnum);
   }
 
-  if (rangep(anum)) {
+  if (ta == RNG) {
     return rcons(roundiv(from(anum), bnum), roundiv(to(anum), bnum));
-  } else if (floatp(anum) || floatp(bnum)) {
+  } else if (ta == FLNUM || tb == FLNUM) {
     val quot = divi(anum, bnum);
 #if HAVE_ROUND
     return flo(round(c_flo(quot, self)));
@@ -4229,8 +4245,10 @@ void arith_init(void)
   r_floor_s = intern(lit("r-floor"), user_package);
   ceil_s = intern(lit("ceil"), user_package);
   ceil1_s = intern(lit("ceil1"), user_package);
+  r_ceil_s = intern(lit("r-ceil"), user_package);
   round_s = intern(lit("round"), user_package);
   round1_s = intern(lit("round1"), user_package);
+  r_round_s = intern(lit("r-round"), user_package);
   sin_s = intern(lit("sin"), user_package);
   cos_s = intern(lit("cos"), user_package);
   tan_s = intern(lit("tan"), user_package);
diff --git a/tests/016/ud-arith.tl b/tests/016/ud-arith.tl
index d086b9e6..052fcaed 100644
--- a/tests/016/ud-arith.tl
+++ b/tests/016/ud-arith.tl
@@ -35,8 +35,12 @@
   (:method floor (me arg) ^(floor ,me.v ,arg))
   (:method r-floor (me arg) ^(floor ,arg ,me.v))
   (:method floor1 (me) ^(floor ,me.v))
-  (:method round1 (me) ^(round ,me.v))
+  (:method ceil (me arg) ^(ceil ,me.v ,arg))
+  (:method r-ceil (me arg) ^(ceil ,arg ,me.v))
   (:method ceil1 (me) ^(ceil ,me.v))
+  (:method round (me arg) ^(round ,me.v ,arg))
+  (:method r-round (me arg) ^(round ,arg ,me.v))
+  (:method round1 (me) ^(round ,me.v))
   (:method sin (me) ^(sin ,me.v))
   (:method cos (me) ^(cos ,me.v))
   (:method tan (me) ^(tan ,me.v))
@@ -102,8 +106,12 @@
 (test (floor n 0) (floor 1 0))
 (test (floor 0 n) (floor 0 1))
 (test (floor n) (floor 1))
-(test (round n) (round 1))
+(test (ceil n 0) (ceil 1 0))
+(test (ceil 0 n) (ceil 0 1))
 (test (ceil n) (ceil 1))
+(test (round n 0) (round 1 0))
+(test (round 0 n) (round 0 1))
+(test (round n) (round 1))
 (test (sin n) (sin 1))
 (test (cos n) (cos 1))
 (test (tan n) (tan 1))
diff --git a/txr.1 b/txr.1
index 8e8273a8..270d96db 100644
--- a/txr.1
+++ b/txr.1
@@ -38223,43 +38223,12 @@ arguments must be integers.
 .bmnl floor
 .bmnr r-floor floor
 .umv floor1 floor
+.bmnl ceil
+.bmnr r-ceil ceil
 .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.
-
+.bmnl round
+.bmnr r-round round
 .umv round1 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