From a66888b6e07dbfd6b22dcd7fa9e240692c17a039 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 26 Feb 2017 07:33:09 -0800
Subject: New floor-rem, ceil-rem and round-rem.

* arith.c (trunc_rem): Move function to below round function.
Make second argument optional, defaulting to one.
(floor_rem, ceil_rem, round_rem): New functions.

* eval.c (eval_init): Registration of trunc-rem altered for
optional argument. New registrations for floor-rem, ceil-rem,
round=rem.

* txr.1: Documented for new functions folded with trunc-rem.
---
 arith.c | 35 ++++++++++++++++++++++++++++-------
 eval.c  |  5 ++++-
 lib.h   |  5 ++++-
 txr.1   | 32 +++++++++++++++++++++++---------
 4 files changed, 59 insertions(+), 18 deletions(-)

diff --git a/arith.c b/arith.c
index 483efa15..1dff8eb6 100644
--- a/arith.c
+++ b/arith.c
@@ -1090,13 +1090,6 @@ divzero:
   uw_throw(numeric_error_s, lit("mod: division by zero"));
 }
 
-val trunc_rem(val anum, val bnum)
-{
-  val quot = trunc(anum, bnum);
-  val rem = minus(anum, mul(quot, bnum));
-  return list(quot, rem, nao);
-}
-
 val floordiv(val anum, val bnum)
 {
   if (missingp(bnum))
@@ -1312,6 +1305,34 @@ val roundiv(val anum, val bnum)
   }
 }
 
+val trunc_rem(val anum, val bnum)
+{
+  val quot = trunc(anum, bnum);
+  val rem = minus(anum, mul(quot, if3(missingp(bnum), one, bnum)));
+  return list(quot, rem, nao);
+}
+
+val floor_rem(val anum, val bnum)
+{
+  val quot = floordiv(anum, bnum);
+  val rem = minus(anum, mul(quot, if3(missingp(bnum), one, bnum)));
+  return list(quot, rem, nao);
+}
+
+val ceil_rem(val anum, val bnum)
+{
+  val quot = ceildiv(anum, bnum);
+  val rem = minus(anum, mul(quot, if3(missingp(bnum), one, bnum)));
+  return list(quot, rem, nao);
+}
+
+val round_rem(val anum, val bnum)
+{
+  val quot = roundiv(anum, bnum);
+  val rem = minus(anum, mul(quot, if3(missingp(bnum), one, bnum)));
+  return list(quot, rem, nao);
+}
+
 val wrap_star(val start, val end, val num)
 {
   val modulus = minus(end, start);
diff --git a/eval.c b/eval.c
index bc58d303..62c24170 100644
--- a/eval.c
+++ b/eval.c
@@ -5693,7 +5693,6 @@ void eval_init(void)
   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("trunc-rem"), user_package), func_n2(trunc_rem));
   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));
@@ -5705,6 +5704,10 @@ void eval_init(void)
   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(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));
diff --git a/lib.h b/lib.h
index 590a912d..9e64ba89 100644
--- a/lib.h
+++ b/lib.h
@@ -636,7 +636,6 @@ val mulv(struct args *);
 val divv(val dividend, struct args *);
 val trunc(val anum, val bnum);
 val mod(val anum, val bnum);
-val trunc_rem(val anum, val bnum);
 val wrap_star(val start, val end, val num);
 val wrap(val start, val end, val num);
 val divi(val anum, val bnum);
@@ -683,6 +682,10 @@ val floordiv(val, val);
 val ceili(val);
 val ceildiv(val anum, val bnum);
 val roundiv(val anum, val bnum);
+val trunc_rem(val anum, val bnum);
+val floor_rem(val anum, val bnum);
+val ceil_rem(val anum, val bnum);
+val round_rem(val anum, val bnum);
 val sine(val);
 val cosi(val);
 val tang(val);
diff --git a/txr.1 b/txr.1
index 2045cf21..8a1e77ae 100644
--- a/txr.1
+++ b/txr.1
@@ -31902,25 +31902,39 @@ then generalized into the floating point domain. For instance the expression
 yields a residue of 0.25 because 0.5 "goes into" 0.75 only
 once, with a "remainder" of 0.25.
 
-.coNP Function @ trunc-rem
+.coNP Functions @, trunc-rem @, floor-rem @ ceil-rem and @ round-rem
 .synb
-.mets (trunc-rem < dividend << divisor )
+.mets (trunc-rem < dividend <> [ divisor ])
+.mets (floor-rem < dividend <> [ divisor ])
+.mets (ceil-rem < dividend <> [ divisor ])
+.mets (round-rem < dividend <> [ divisor ])
 .syne
 .desc
-The
-.code trunc-rem
-function returns a list of two values: a
+These functions, respectively, perform the same division operation
+as
+.codn trunc ,
+.codn floor ,
+.codn ceil ,
+and
+.codn round ,
+referred to here as the respective target functions.
+
+If the
+.meta divisor
+is missing, it defaults to 1.
+
+Each function returns a list of two values: a
 .meta quotient
 and a
 .metn remainder .
 The
 .meta quotient
-is exactly the same value as what
-.code trunc
-would return for the same inputs.
+is exactly the same value as what would be returned by the
+respective target function for the same inputs.
+
 The
 .meta remainder
-obeys the following identity:
+value obeys the following identity:
 
 .cblk
 .mets (eql < remainder (- < dividend >> (* divisor << quotient )))
-- 
cgit v1.2.3