* arith.c (wrap_star, wrap): New functions.

* eval.c (eval_init): Registered wrap and wrap* intrinsics.

* lib.h (wrap_star, wrap): Declared.

* txr.1: wrap and wrap* documented.

5 files changed, 86 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index ca96b0de..7b5ae180 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
 2014-11-20  Kaz Kylheku  <kaz@kylheku.com>
 
+	* arith.c (wrap_star, wrap): New functions.
+
+	* eval.c (eval_init): Registered wrap and wrap* intrinsics.
+
+	* lib.h (wrap_star, wrap): Declared.
+
+	* txr.1: wrap and wrap* documented.
+
+2014-11-20  Kaz Kylheku  <kaz@kylheku.com>
+
 	* arith.c (succ, ssucc, sssucc, pred, ppred, pppred): New functions.
 
 	* eval.c (eval_init): Register new functions as intrinsics.
diff --git a/arith.c b/arith.c
index 23cf66a8..00621a5d 100644
--- a/arith.c
+++ b/arith.c
@@ -938,6 +938,19 @@ divzero:
   uw_throw(numeric_error_s, lit("mod: division by zero"));
 }
 
+val wrap_star(val start, val end, val num)
+{
+  val modulus = minus(end, start);
+  val num_off = minus(num, start);
+  val num_mod = mod(num_off, modulus);
+  return plus(start, num_mod);
+}
+
+val wrap(val start, val end, val num)
+{
+  return wrap_star(start, succ(end), num);
+}
+
 static val to_float(val func, val num)
 {
   switch (type(num)) {
diff --git a/eval.c b/eval.c
index ab11ebef..ef9b5cd7 100644
--- a/eval.c
+++ b/eval.c
@@ -3677,6 +3677,8 @@ void eval_init(void)
   reg_fun(intern(lit("abs"), user_package), func_n1(abso));
   reg_fun(intern(lit("trunc"), user_package), func_n2(trunc));
   reg_fun(intern(lit("mod"), user_package), func_n2(mod));
+  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_n2o(divi, 1));
   reg_fun(intern(lit("expt"), user_package), func_n0v(exptv));
   reg_fun(intern(lit("exptmod"), user_package), func_n3(exptmod));
diff --git a/lib.h b/lib.h
index 80a56c14..c5c187ff 100644
--- a/lib.h
+++ b/lib.h
@@ -538,6 +538,8 @@ val mul(val anum, val bnum);
 val mulv(val nlist);
 val trunc(val anum, val bnum);
 val mod(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);
 val zerop(val num);
 val evenp(val num);
diff --git a/txr.1 b/txr.1
index fd1e1822..8c950bad 100644
--- a/txr.1
+++ b/txr.1
@@ -18035,6 +18035,65 @@ 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 Functions @ wrap and @ wrap*
+.synb
+.mets (wrap < start < end << number )
+.mets (wrap < start < end << number )
+.syne
+.desc
+The
+.code wrap
+and
+.code wrap*
+functions reduce
+.meta number
+into the range specified by
+.meta start
+and
+.metn end .
+
+Under
+.code wrap
+the range is inclusive of the
+.meta end
+value, whereas under
+.code wrap*
+it is exclusive.
+
+The following equivalence holds
+
+.cblk
+  (wrap a b c) <--> (wrap* a (succ b) c)
+.cble
+
+The expression
+.code (wrap* x0 x1 x)
+performs the following calculation:
+
+.cblk
+.meti (+ (mod (- x x0) (- x1 x0)) x0)
+.cble
+
+In other words, first
+.meta start
+is subtracted from
+.metn number .
+Then the result is reduced modulo the displacement
+between
+.code start
+and
+.codn end .
+Finally,
+.meta start
+is added back to that result, which is returned.
+
+.TP* Example:
+
+.cblk
+  ;; perform ROT13 on the string "nop"
+  [mapcar (opip (+ 13) (wrap #\ea #\ez)) "nop"] -> "abc"
+.cble
+
 .coNP Functions @ gcd and @ lcm
 .synb
 .mets (gcd << number *)