* arith.c (gcd): Fix semantics. If either operand is

zero, return the other operand.
(lcm): New function.

* eval.c (eval_init): Retarget registration of gcd to
variable argument gcdv function. Register lcm.

* lib.c (gcdv, lcmv): New functions.

* lib.h (gcdv, lcm, lcmv): Declared.

* txr.1: Re-document gcd with coverage of lcm.

* txr.vim: Regenerated.

7 files changed, 201 insertions, 123 deletions

diff --git a/ChangeLog b/ChangeLog
index 2aff9393..facc151b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,22 @@
 2014-10-16  Kaz Kylheku  <kaz@kylheku.com>
 
+	* arith.c (gcd): Fix semantics. If either operand is
+	zero, return the other operand.
+	(lcm): New function.
+
+	* eval.c (eval_init): Retarget registration of gcd to
+	variable argument gcdv function. Register lcm.
+
+	* lib.c (gcdv, lcmv): New functions.
+
+	* lib.h (gcdv, lcm, lcmv): Declared.
+
+	* txr.1: Re-document gcd with coverage of lcm.
+
+	* txr.vim: Regenerated.
+
+2014-10-16  Kaz Kylheku  <kaz@kylheku.com>
+
 	* arith.c (gcd, lognot): Bugfix: bignum results
 	in fixnum range not normalized.
 
diff --git a/arith.c b/arith.c
index 76066d63..7699ad11 100644
--- a/arith.c
+++ b/arith.c
@@ -1375,8 +1375,11 @@ val gcd(val anum, val bnum)
   if (!integerp(anum) || !integerp(bnum))
     goto inval;
 
-  if (zerop(anum))
-    return zero;
+  if (anum == zero)
+    return bnum;
+
+  if (bnum == zero)
+    return anum;
 
   if (fixnump(anum))
     anum = bignum(c_num(anum));
@@ -1398,6 +1401,17 @@ bad:
             anum, bnum, nao);
 }
 
+val lcm(val anum, val bnum)
+{
+  if (anum == zero || bnum == zero) {
+    return zero;
+  } else {
+    val prod = mul(anum, bnum);
+    val gcdv = gcd(anum, bnum);
+    return abso(trunc(prod, gcdv));
+  }
+}
+
 val floorf(val num)
 {
   if (integerp(num))
diff --git a/eval.c b/eval.c
index 753d0211..5a5e7baf 100644
--- a/eval.c
+++ b/eval.c
@@ -3605,7 +3605,8 @@ void eval_init(void)
   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("gcd"), user_package), func_n2(gcd));
+  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_n1(floorf));
   reg_fun(intern(lit("ceil"), user_package), func_n1(ceili));
   reg_fun(intern(lit("sin"), user_package), func_n1(sine));
diff --git a/lib.c b/lib.c
index d25e47e3..4b929c97 100644
--- a/lib.c
+++ b/lib.c
@@ -2150,6 +2150,24 @@ val exptv(val nlist)
   return reduce_right(func_n2(expt), nlist, one, nil);
 }
 
+val gcdv(val nlist)
+{
+  if (!nlist)
+    return zero;
+  if (!cdr(nlist))
+    return abso(car(nlist));
+  return reduce_left(func_n2(gcd), nlist, colon_k, nil);
+}
+
+val lcmv(val nlist)
+{
+  if (!nlist)
+    return one;
+  if (!cdr(nlist))
+    return abso(car(nlist));
+  return reduce_left(func_n2(lcm), nlist, colon_k, nil);
+}
+
 val string_own(wchar_t *str)
 {
   val obj = make_obj();
diff --git a/lib.h b/lib.h
index cf1a8d4f..fd4763e0 100644
--- a/lib.h
+++ b/lib.h
@@ -538,6 +538,9 @@ val exptmod(val base, val exp, val mod);
 val sqroot(val anum);
 val isqrt(val anum);
 val gcd(val anum, val bnum);
+val gcdv(val nlist);
+val lcm(val anum, val bnum);
+val lcmv(val nlist);
 val floorf(val);
 val ceili(val);
 val sine(val);
diff --git a/txr.1 b/txr.1
index 0120ef56..e7097a20 100644
--- a/txr.1
+++ b/txr.1
@@ -17745,7 +17745,7 @@ and tests for termination with
 .codn nil .
 
 .SS* Math Library
-.coNP Arithmetic functions @ + and @ -
+.coNP Functions @ + and @ -
 .synb
 .mets (+ << number *)
 .mets (- < number << number *)
@@ -17910,44 +17910,69 @@ 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 @ gcd
+.coNP Functions @ gcd and @ lcm
 .synb
-.mods (gcd < left << right )
+.mets (gcd << number *)
+.mets (lcm << number *)
 .syne
 .desc
 The
 .code gcd
 function computes the greatest common divisor: the largest positive
-integer which divides both arguments.
+integer which divides each
+.metn number .
 
-Operands
-.meta left
-and
-.meta right
-must be integers, or else an exception is thrown.
+The
+.code lcm
+function computes the lowest common multiple: the smallest positive
+integer which is a multiple of
+each
+.metn number .
+
+Each
+.meta number
+must be an integer.
+
+Negative integers are replaced by their absolute values, so
+.code (lcm -3 -4)
+is
+.code 12 
+and 
+.code (gcd -12 -9)
+yields
+.codn 3 .
 
 The value of
-.code (gcd 0 x)
-is 0 for all
-.codn x ,
-including 0.
+.code (gcd)
+is
+.code 0
+and that of
+.code (lcm)
+is 1 .
 
 The value of
-.code (gcd x 123)
+.code (gcd x)
+and
+.code (lcm x)
 is
-.code (abs x)
-for all
-.codn x .
+.codn (abs x) .
 
-Negative operands are permitted; this operation effectively ignores sign, so
-that the value of
-.code (gcd x y)
-is the same as
-.code (gcd (abs x) (abs y))
-for all
-.code x
+Any arguments of
+.code gcd
+which are zero are effectively ignored so that
+.code (gcd 0)
 and
-.codn y .
+.code (gcd 0 0 0)
+are both the same as
+.code (gcd)
+and
+.code (gcd 1 0 2 0 3)
+is the same as
+.codn (gcd 1 2 3) .
+
+If
+.code lcm
+has any argument which is zero, it yields zero.
 
 .coNP Function @ abs
 .synb
diff --git a/txr.vim b/txr.vim
index ab62aec3..d330d812 100644
--- a/txr.vim
+++ b/txr.vim
@@ -97,101 +97,101 @@ syn keyword txl_keyword contained itimer-prov itimer-real itimer-virtual juxt
 syn keyword txl_keyword contained keep-if keep-if* keywordp kill
 syn keyword txl_keyword contained labels lambda last lazy-str
 syn keyword txl_keyword contained lazy-str-force lazy-str-force-upto lazy-str-get-trailing-list lazy-stream-cons
-syn keyword txl_keyword contained lazy-stringp lbind lcons-fun lconsp
-syn keyword txl_keyword contained ldiff length length-list length-str
-syn keyword txl_keyword contained length-str-< length-str-<= length-str-> length-str->=
-syn keyword txl_keyword contained length-vec less let let*
-syn keyword txl_keyword contained link lisp-parse list list*
-syn keyword txl_keyword contained list-str list-vector listp log
-syn keyword txl_keyword contained log-alert log-auth log-authpriv log-cons
-syn keyword txl_keyword contained log-crit log-daemon log-debug log-emerg
-syn keyword txl_keyword contained log-err log-info log-ndelay log-notice
-syn keyword txl_keyword contained log-nowait log-odelay log-perror log-pid
-syn keyword txl_keyword contained log-user log-warning log10 log2
-syn keyword txl_keyword contained logand logior lognot logtest
-syn keyword txl_keyword contained logtrunc logxor macro-form-p macro-time
-syn keyword txl_keyword contained macroexpand macroexpand-1 macrolet major
-syn keyword txl_keyword contained make-catenated-stream make-env make-hash make-lazy-cons
-syn keyword txl_keyword contained make-like make-package make-random-state make-similar-hash
-syn keyword txl_keyword contained make-string-byte-input-stream make-string-input-stream make-string-output-stream make-strlist-output-stream
-syn keyword txl_keyword contained make-sym make-time make-time-utc make-trie
-syn keyword txl_keyword contained makedev mapcar mapcar* mapdo
-syn keyword txl_keyword contained maphash mappend mappend* mask
-syn keyword txl_keyword contained match-fun match-regex match-regex-right match-str
-syn keyword txl_keyword contained match-str-tree max member member-if
-syn keyword txl_keyword contained memq memql memqual merge
-syn keyword txl_keyword contained min minor mkdir mknod
-syn keyword txl_keyword contained mkstring mod multi multi-sort
-syn keyword txl_keyword contained n-choose-k n-perm-k nconc nilf
-syn keyword txl_keyword contained none not nreverse null
-syn keyword txl_keyword contained nullify num-chr num-str numberp
-syn keyword txl_keyword contained oddp op open-command open-directory
-syn keyword txl_keyword contained open-file open-files open-files* open-pipe
-syn keyword txl_keyword contained open-process open-tail openlog or
-syn keyword txl_keyword contained orf packagep partition partition*
-syn keyword txl_keyword contained partition-by perm pop pos
-syn keyword txl_keyword contained pos-if pos-max pos-min posq
-syn keyword txl_keyword contained posql posqual pprinl pprint
-syn keyword txl_keyword contained pprof prinl print prof
-syn keyword txl_keyword contained prog1 progn prop proper-listp
-syn keyword txl_keyword contained push pushhash put-byte put-char
-syn keyword txl_keyword contained put-line put-lines put-string put-strings
-syn keyword txl_keyword contained pwd qquote quasi quasilist
-syn keyword txl_keyword contained quote rand random random-fixnum
-syn keyword txl_keyword contained random-state-p range range* range-regex
-syn keyword txl_keyword contained rcomb read readlink real-time-stream-p
-syn keyword txl_keyword contained reduce-left reduce-right ref refset
-syn keyword txl_keyword contained regex-compile regex-parse regexp regsub
-syn keyword txl_keyword contained rehome-sym remhash remove-if remove-if*
-syn keyword txl_keyword contained remove-path remq remq* remql
-syn keyword txl_keyword contained remql* remqual remqual* rename-path
-syn keyword txl_keyword contained repeat replace replace-list replace-str
-syn keyword txl_keyword contained replace-vec rest ret retf
-syn keyword txl_keyword contained return return-from reverse rlcp
-syn keyword txl_keyword contained rperm rplaca rplacd run
-syn keyword txl_keyword contained s-ifblk s-ifchr s-ifdir s-ififo
-syn keyword txl_keyword contained s-iflnk s-ifmt s-ifreg s-ifsock
-syn keyword txl_keyword contained s-irgrp s-iroth s-irusr s-irwxg
-syn keyword txl_keyword contained s-irwxo s-irwxu s-isgid s-isuid
-syn keyword txl_keyword contained s-isvtx s-iwgrp s-iwoth s-iwusr
-syn keyword txl_keyword contained s-ixgrp s-ixoth s-ixusr search
-syn keyword txl_keyword contained search-regex search-str search-str-tree second
-syn keyword txl_keyword contained seek-stream select seqp set
-syn keyword txl_keyword contained set-diff set-hash-userdata set-sig-handler sethash
-syn keyword txl_keyword contained setitimer setlogmask sh sig-abrt
-syn keyword txl_keyword contained sig-alrm sig-bus sig-check sig-chld
-syn keyword txl_keyword contained sig-cont sig-fpe sig-hup sig-ill
-syn keyword txl_keyword contained sig-int sig-io sig-iot sig-kill
-syn keyword txl_keyword contained sig-lost sig-pipe sig-poll sig-prof
-syn keyword txl_keyword contained sig-pwr sig-quit sig-segv sig-stkflt
-syn keyword txl_keyword contained sig-stop sig-sys sig-term sig-trap
-syn keyword txl_keyword contained sig-tstp sig-ttin sig-ttou sig-urg
-syn keyword txl_keyword contained sig-usr1 sig-usr2 sig-vtalrm sig-winch
-syn keyword txl_keyword contained sig-xcpu sig-xfsz sin sixth
-syn keyword txl_keyword contained size-vec some sort source-loc
-syn keyword txl_keyword contained source-loc-str span-str splice split-str
-syn keyword txl_keyword contained split-str-set sqrt stat stdlib
-syn keyword txl_keyword contained str< str<= str= str>
-syn keyword txl_keyword contained str>= stream-get-prop stream-set-prop streamp
-syn keyword txl_keyword contained string-extend string-lt stringp sub
-syn keyword txl_keyword contained sub-list sub-str sub-vec symacrolet
-syn keyword txl_keyword contained symbol-function symbol-name symbol-package symbol-value
-syn keyword txl_keyword contained symbolp symlink sys-qquote sys-splice
-syn keyword txl_keyword contained sys-unquote syslog tan tf
-syn keyword txl_keyword contained third throw throwf time
-syn keyword txl_keyword contained time-fields-local time-fields-utc time-string-local time-string-utc
-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 typeof unget-byte unget-char uniq
-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 with-saved-vars
-syn keyword txl_keyword contained zerop zip
+syn keyword txl_keyword contained lazy-stringp lbind lcm lcons-fun
+syn keyword txl_keyword contained lconsp ldiff length length-list
+syn keyword txl_keyword contained length-str length-str-< length-str-<= length-str->
+syn keyword txl_keyword contained length-str->= length-vec less let
+syn keyword txl_keyword contained let* link lisp-parse list
+syn keyword txl_keyword contained list* list-str list-vector listp
+syn keyword txl_keyword contained log log-alert log-auth log-authpriv
+syn keyword txl_keyword contained log-cons log-crit log-daemon log-debug
+syn keyword txl_keyword contained log-emerg log-err log-info log-ndelay
+syn keyword txl_keyword contained log-notice log-nowait log-odelay log-perror
+syn keyword txl_keyword contained log-pid log-user log-warning log10
+syn keyword txl_keyword contained log2 logand logior lognot
+syn keyword txl_keyword contained logtest logtrunc logxor macro-form-p
+syn keyword txl_keyword contained macro-time macroexpand macroexpand-1 macrolet
+syn keyword txl_keyword contained major make-catenated-stream make-env make-hash
+syn keyword txl_keyword contained make-lazy-cons make-like make-package make-random-state
+syn keyword txl_keyword contained make-similar-hash make-string-byte-input-stream make-string-input-stream make-string-output-stream
+syn keyword txl_keyword contained make-strlist-output-stream make-sym make-time make-time-utc
+syn keyword txl_keyword contained make-trie makedev mapcar mapcar*
+syn keyword txl_keyword contained mapdo maphash mappend mappend*
+syn keyword txl_keyword contained mask match-fun match-regex match-regex-right
+syn keyword txl_keyword contained match-str match-str-tree max member
+syn keyword txl_keyword contained member-if memq memql memqual
+syn keyword txl_keyword contained merge min minor mkdir
+syn keyword txl_keyword contained mknod mkstring mod multi
+syn keyword txl_keyword contained multi-sort n-choose-k n-perm-k nconc
+syn keyword txl_keyword contained nilf none not nreverse
+syn keyword txl_keyword contained null nullify num-chr num-str
+syn keyword txl_keyword contained numberp oddp op open-command
+syn keyword txl_keyword contained open-directory open-file open-files open-files*
+syn keyword txl_keyword contained open-pipe open-process open-tail openlog
+syn keyword txl_keyword contained or orf packagep partition
+syn keyword txl_keyword contained partition* partition-by perm pop
+syn keyword txl_keyword contained pos pos-if pos-max pos-min
+syn keyword txl_keyword contained posq posql posqual pprinl
+syn keyword txl_keyword contained pprint pprof prinl print
+syn keyword txl_keyword contained prof prog1 progn prop
+syn keyword txl_keyword contained proper-listp push pushhash put-byte
+syn keyword txl_keyword contained put-char put-line put-lines put-string
+syn keyword txl_keyword contained put-strings pwd qquote quasi
+syn keyword txl_keyword contained quasilist quote rand random
+syn keyword txl_keyword contained random-fixnum random-state-p range range*
+syn keyword txl_keyword contained range-regex rcomb read readlink
+syn keyword txl_keyword contained real-time-stream-p reduce-left reduce-right ref
+syn keyword txl_keyword contained refset regex-compile regex-parse regexp
+syn keyword txl_keyword contained regsub rehome-sym remhash remove-if
+syn keyword txl_keyword contained remove-if* remove-path remq remq*
+syn keyword txl_keyword contained remql remql* remqual remqual*
+syn keyword txl_keyword contained rename-path repeat replace replace-list
+syn keyword txl_keyword contained replace-str replace-vec rest ret
+syn keyword txl_keyword contained retf return return-from reverse
+syn keyword txl_keyword contained rlcp rperm rplaca rplacd
+syn keyword txl_keyword contained run s-ifblk s-ifchr s-ifdir
+syn keyword txl_keyword contained s-ififo s-iflnk s-ifmt s-ifreg
+syn keyword txl_keyword contained s-ifsock s-irgrp s-iroth s-irusr
+syn keyword txl_keyword contained s-irwxg s-irwxo s-irwxu s-isgid
+syn keyword txl_keyword contained s-isuid s-isvtx s-iwgrp s-iwoth
+syn keyword txl_keyword contained s-iwusr s-ixgrp s-ixoth s-ixusr
+syn keyword txl_keyword contained search search-regex search-str search-str-tree
+syn keyword txl_keyword contained second seek-stream select seqp
+syn keyword txl_keyword contained set set-diff set-hash-userdata set-sig-handler
+syn keyword txl_keyword contained sethash setitimer setlogmask sh
+syn keyword txl_keyword contained sig-abrt sig-alrm sig-bus sig-check
+syn keyword txl_keyword contained sig-chld sig-cont sig-fpe sig-hup
+syn keyword txl_keyword contained sig-ill sig-int sig-io sig-iot
+syn keyword txl_keyword contained sig-kill sig-lost sig-pipe sig-poll
+syn keyword txl_keyword contained sig-prof sig-pwr sig-quit sig-segv
+syn keyword txl_keyword contained sig-stkflt sig-stop sig-sys sig-term
+syn keyword txl_keyword contained sig-trap sig-tstp sig-ttin sig-ttou
+syn keyword txl_keyword contained sig-urg sig-usr1 sig-usr2 sig-vtalrm
+syn keyword txl_keyword contained sig-winch sig-xcpu sig-xfsz sin
+syn keyword txl_keyword contained sixth size-vec some sort
+syn keyword txl_keyword contained source-loc source-loc-str span-str splice
+syn keyword txl_keyword contained split-str split-str-set sqrt stat
+syn keyword txl_keyword contained stdlib str< str<= str=
+syn keyword txl_keyword contained str> str>= stream-get-prop stream-set-prop
+syn keyword txl_keyword contained streamp string-extend string-lt stringp
+syn keyword txl_keyword contained sub sub-list sub-str sub-vec
+syn keyword txl_keyword contained symacrolet symbol-function symbol-name symbol-package
+syn keyword txl_keyword contained symbol-value symbolp symlink sys-qquote
+syn keyword txl_keyword contained sys-splice sys-unquote syslog tan
+syn keyword txl_keyword contained tf third throw throwf
+syn keyword txl_keyword contained time time-fields-local time-fields-utc time-string-local
+syn keyword txl_keyword contained time-string-utc time-usec tofloat toint
+syn keyword txl_keyword contained tok-str tok-where tostring tostringp
+syn keyword txl_keyword contained transpose tree-bind tree-case tree-find
+syn keyword txl_keyword contained trie-add trie-compress trie-lookup-begin trie-lookup-feed-char
+syn keyword txl_keyword contained trie-value-at trim-str true trunc
+syn keyword txl_keyword contained tuples typeof unget-byte unget-char
+syn keyword txl_keyword contained uniq 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 with-saved-vars zerop zip
 
 syn match txr_error "@[\t ]*[*]\?[\t ]*."
 syn match txr_nested_error "[^\t `]\+" contained