* arith.c (trunc_rem): New function.

* eval.c (eval_init): Register trunc-rem intrinsic.

* lib.h (trunc_rem): Declared.

* txr.1: Documented trunc-rem.

* tl.vim, txr.vim: Updated.

7 files changed, 62 insertions, 21 deletions

diff --git a/ChangeLog b/ChangeLog
index 629da96e..5ed01bd9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,17 @@
 2015-02-07  Kaz Kylheku  <kaz@kylheku.com>
 
+	* arith.c (trunc_rem): New function.
+
+	* eval.c (eval_init): Register trunc-rem intrinsic.
+
+	* lib.h (trunc_rem): Declared.
+
+	* txr.1: Documented trunc-rem.
+
+	* tl.vim, txr.vim: Updated.
+
+2015-02-07  Kaz Kylheku  <kaz@kylheku.com>
+
 	* Makefile (CFLAGS): Removed puzzling, unnecessary definitions
 	of XMALLOC, XCALLOC, XREALLOC and XFREE for $(MPI_OBJS). MPI
 	does not use such macros and the allocator is already retargetted
diff --git a/arith.c b/arith.c
index 20d1ae3b..9aeb0875 100644
--- a/arith.c
+++ b/arith.c
@@ -945,6 +945,13 @@ 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 wrap_star(val start, val end, val num)
 {
   val modulus = minus(end, start);
diff --git a/eval.c b/eval.c
index 056f4b68..7f8f746f 100644
--- a/eval.c
+++ b/eval.c
@@ -3846,6 +3846,7 @@ 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("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_n2o(divi, 1));
diff --git a/lib.h b/lib.h
index 984dd851..2ce36aaf 100644
--- a/lib.h
+++ b/lib.h
@@ -544,6 +544,7 @@ val mul(val anum, val bnum);
 val mulv(val nlist);
 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);
diff --git a/tl.vim b/tl.vim
index 402fc22b..057dcad2 100644
--- a/tl.vim
+++ b/tl.vim
@@ -181,16 +181,16 @@ syn keyword txl_keyword contained time-usec tofloat toint tok-str
 syn keyword txl_keyword contained tok-where tostring tostringp transpose
 syn keyword txl_keyword contained tree-bind tree-case tree-find trie-add
 syn keyword txl_keyword contained trie-compress trie-lookup-begin trie-lookup-feed-char trie-value-at
-syn keyword txl_keyword contained trim-str true trunc tuples
-syn keyword txl_keyword contained txr-case txr-if txr-when typeof
-syn keyword txl_keyword contained unget-byte unget-char uniq unique
-syn keyword txl_keyword contained unless unquote until upcase-str
-syn keyword txl_keyword contained update url-decode url-encode usleep
-syn keyword txl_keyword contained uw-protect vec vec-push vec-set-length
-syn keyword txl_keyword contained vecref vector vector-list vectorp
-syn keyword txl_keyword contained when where while width
-syn keyword txl_keyword contained with-saved-vars wrap wrap* zerop
-syn keyword txl_keyword contained zip
+syn keyword txl_keyword contained trim-str true trunc trunc-rem
+syn keyword txl_keyword contained tuples txr-case txr-if txr-when
+syn keyword txl_keyword contained typeof unget-byte unget-char uniq
+syn keyword txl_keyword contained unique unless unquote until
+syn keyword txl_keyword contained upcase-str update url-decode url-encode
+syn keyword txl_keyword contained usleep uw-protect vec vec-push
+syn keyword txl_keyword contained vec-set-length vecref vector vector-list
+syn keyword txl_keyword contained vectorp when where while
+syn keyword txl_keyword contained width with-saved-vars wrap wrap*
+syn keyword txl_keyword contained zerop zip
 syn match txr_metanum "@[0-9]\+"
 syn match txr_nested_error "[^\t `]\+" contained
 
diff --git a/txr.1 b/txr.1
index 2c467d22..b81fc0b1 100644
--- a/txr.1
+++ b/txr.1
@@ -18250,11 +18250,12 @@ A character may not be an operand of multiplication.
 
 .PP
 
-.coNP Functions @, / @ trunc and @ mod
+.coNP Functions @, / @ trunc, @ mod and @ trunc-rem
 .synb
 .mets (/ <> [ dividend ] << divisor )
 .mets (trunc < dividend << divisor )
 .mets (mod < dividend << divisor )
+.mets (trunc-rem < dividend << divisor )
 .syne
 .desc
 The arguments to these functions are numbers. Characters are not permitted.
@@ -18308,6 +18309,25 @@ 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.
 
+The
+.code trunc-rem
+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.
+The
+.meta remainder
+obeys the following identity:
+
+.cblk
+.mets (eql < remainder (- < dividend >> (* divisor << quotient )))
+.cble
+
 .coNP Functions @ wrap and @ wrap*
 .synb
 .mets (wrap < start < end << number )
diff --git a/txr.vim b/txr.vim
index 97c0b2e2..82fb22fc 100644
--- a/txr.vim
+++ b/txr.vim
@@ -181,16 +181,16 @@ syn keyword txl_keyword contained time-usec tofloat toint tok-str
 syn keyword txl_keyword contained tok-where tostring tostringp transpose
 syn keyword txl_keyword contained tree-bind tree-case tree-find trie-add
 syn keyword txl_keyword contained trie-compress trie-lookup-begin trie-lookup-feed-char trie-value-at
-syn keyword txl_keyword contained trim-str true trunc tuples
-syn keyword txl_keyword contained txr-case txr-if txr-when typeof
-syn keyword txl_keyword contained unget-byte unget-char uniq unique
-syn keyword txl_keyword contained unless unquote until upcase-str
-syn keyword txl_keyword contained update url-decode url-encode usleep
-syn keyword txl_keyword contained uw-protect vec vec-push vec-set-length
-syn keyword txl_keyword contained vecref vector vector-list vectorp
-syn keyword txl_keyword contained when where while width
-syn keyword txl_keyword contained with-saved-vars wrap wrap* zerop
-syn keyword txl_keyword contained zip
+syn keyword txl_keyword contained trim-str true trunc trunc-rem
+syn keyword txl_keyword contained tuples txr-case txr-if txr-when
+syn keyword txl_keyword contained typeof unget-byte unget-char uniq
+syn keyword txl_keyword contained unique unless unquote until
+syn keyword txl_keyword contained upcase-str update url-decode url-encode
+syn keyword txl_keyword contained usleep uw-protect vec vec-push
+syn keyword txl_keyword contained vec-set-length vecref vector vector-list
+syn keyword txl_keyword contained vectorp when where while
+syn keyword txl_keyword contained width with-saved-vars wrap wrap*
+syn keyword txl_keyword contained zerop zip
 
 syn keyword txr_keyword contained accept all and assert
 syn keyword txr_keyword contained bind block cases cat