diff options
| -rw-r--r-- | ChangeLog | 17 | ||||
| -rw-r--r-- | arith.c | 18 | ||||
| -rw-r--r-- | eval.c | 3 | ||||
| -rw-r--r-- | lib.c | 18 | ||||
| -rw-r--r-- | lib.h | 3 | ||||
| -rw-r--r-- | txr.1 | 75 | ||||
| -rw-r--r-- | txr.vim | 190 |
7 files changed, 201 insertions, 123 deletions
@@ -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. @@ -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)) @@ -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)); @@ -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(); @@ -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); @@ -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 @@ -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 |