- cmucl-cvs - mailman3.common-lisp.net

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-25-g2b39eba
by Raymond Toy 28 Nov '14

28 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 2b39eba64aa3f2b122bcc275e6597f9cb2a5f7f4 (commit) from 55d04a31ba05d20f4e9ab6be9548d374c900b197 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 2b39eba64aa3f2b122bcc275e6597f9cb2a5f7f4 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Fri Nov 28 10:21:52 2014 -0800 Correct the tests for the generic function lambda lists. The check for invalid gf lambda lists happens during macroexpansion, so update the tests to catch this during macroexpansion. This fixes three of the issues in ticket:95. diff --git a/tests/pcl/defgeneric.lisp b/tests/pcl/defgeneric.lisp index 05f01c7..2cf9e07 100644 --- a/tests/pcl/defgeneric.lisp +++ b/tests/pcl/defgeneric.lisp @@ -32,13 +32,12 @@ (in-package "PCL-TESTS") +;; These errors are signaled during macroexpansion of the defgeneric +;; form so catch the errors during macroexpansion. (defmacro define-gf-lambda-list-test (name lambda-list) - `(deftest ,name - (multiple-value-bind (r c) - (ignore-errors - (defgeneric g ,lambda-list)) - (values (null r) (typep c 'error))) - t t)) + `(define-test ,name + (assert-error 'program-error + (macroexpand '(defgeneric g ,lambda-list))))) (define-gf-lambda-list-test defgeneric-lambda-list.0 (a &optional (b 1))) (define-gf-lambda-list-test defgeneric-lambda-list.1 (a &key (b 1))) ----------------------------------------------------------------------- Summary of changes: tests/pcl/defgeneric.lisp | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-24-g55d04a3
by Raymond Toy 27 Nov '14

27 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 55d04a31ba05d20f4e9ab6be9548d374c900b197 (commit) from 37d383ae57c2fc9597cb87eac9551af866885cd3 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 55d04a31ba05d20f4e9ab6be9548d374c900b197 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Nov 26 18:35:05 2014 -0800 Fix up a few more issues with log. * src/code/irrat.lisp: * In log10, return the correct type for the result. Previously, we would return a double even if a single were desired. * Fix up a few more cases where we failed to handle log of a huge rational correctly for log base 2 and base 10. * tests/irrat.lisp: * Add some tests to check that log returns the correct type of number for the log base 2 and 10 of very large rationals. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 325e5bc..0804ef9 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -653,10 +653,10 @@ ;; Number fits in a double, so it's easy (float (%log10 d) float-type)) (t - ;; Number doesn't fit in a double. Do it the hard way. - ;; This should be done more accurately. - (/ (log2 number float-type) - (log2 (float 10 float-type))))))) + ;; Number doesn't fit in a double. Do it the hard way using + ;; log2. This should be done more accurately. + (float (/ (log2 number) + (log2 10)) float-type))))) (defun log (number &optional (base nil base-p)) "Return the logarithm of NUMBER in the base BASE, which defaults to e." @@ -692,10 +692,14 @@ double-float) (log2 number 1d0)) #+double-double - (((foreach integer ratio single-float double-float) + (((foreach single-float double-float) double-double-float) (dd-%log2 (float number 1w0))) #+double-double + (((foreach integer ratio) + double-double-float) + (log2 number 1w0)) + #+double-double ((double-double-float (foreach integer ratio single-float double-float double-double-float)) (dd-%log2 number)))) @@ -722,7 +726,11 @@ double-float) (log10 number 1d0)) #+double-double - (((foreach integer ratio single-float double-float) + (((foreach integer ratio) + ext:double-double-float) + (log10 number 1w0)) + #+double-double + (((foreach single-float double-float) ext:double-double-float) (dd-%log10 (float number 1w0))) #+double-double diff --git a/tests/irrat.lisp b/tests/irrat.lisp index 9538394..a6a405d 100644 --- a/tests/irrat.lisp +++ b/tests/irrat.lisp @@ -88,7 +88,12 @@ (let ((y (kernel::dd-%log2 (sqrt 0.5w0)))) (assert-true (<= (relerr y -1/2) (* 2.7 (scale-float 1d0 (- (float-digits 1w0))))) - y))) + y)) + (assert-true (typep (log (ash 1 3000) 2) 'single-float)) + (assert-true (typep (log (ash 1 3000) 2f0) 'single-float)) + (assert-true (typep (log (ash 1 3000) 2d0) 'double-float)) + (assert-true (typep (log (ash 1 3000) 2w0) 'ext:double-double-float))) + (define-test dd-log2.powers-of-2 (loop for k from -1074 below 1024 @@ -100,7 +105,11 @@ (define-test dd-log10.special-cases (let ((y (kernel::dd-%log10 (sqrt 10w0)))) (assert-true (<= (relerr y 1/2) - (* 0.25 (scale-float 1d0 (- (float-digits 1w0)))))))) + (* 0.25 (scale-float 1d0 (- (float-digits 1w0))))))) + (assert-true (typep (log (ash 1 3000) 10) 'single-float)) + (assert-true (typep (log (ash 1 3000) 10f0) 'single-float)) + (assert-true (typep (log (ash 1 3000) 10d0) 'double-float)) + (assert-true (typep (log (ash 1 3000) 10w0) 'ext:double-double-float))) (define-test dd-log10.powers-of-ten ;; It would be nice if dd-%log10 produce the exact result for powers ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 20 ++++++++++++++------ tests/irrat.lisp | 13 +++++++++++-- 2 files changed, 25 insertions(+), 8 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-23-g37d383a
by Raymond Toy 26 Nov '14

26 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 37d383ae57c2fc9597cb87eac9551af866885cd3 (commit) from 0a522bd0c8c38f6ee76f0cc2122d9984c4e269aa (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 37d383ae57c2fc9597cb87eac9551af866885cd3 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Nov 26 14:04:29 2014 -0800 Fix some issues with log2 and log10 of big rationals. * src/code/irrat.lisp: * Add log10 function to handle the computation of the base 10 log of big rationals that might not fit in a double-float. * Fix some issues where CL:LOG wasn't handling logs of big rationals. (A regression). * tests/trac.lisp: * Update trac.8 test to include logs base 10. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 568fa46..325e5bc 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -645,6 +645,19 @@ (log2-bignum x) (+ n frac)))))) +;; Handle the case where number could be so large that it doesn't fit +;; in a double-float. +(defun log10 (number &optional (float-type 1d0)) + (let ((d (ignore-errors (float number 1d0)))) + (cond (d + ;; Number fits in a double, so it's easy + (float (%log10 d) float-type)) + (t + ;; Number doesn't fit in a double. Do it the hard way. + ;; This should be done more accurately. + (/ (log2 number float-type) + (log2 (float 10 float-type))))))) + (defun log (number &optional (base nil base-p)) "Return the logarithm of NUMBER in the base BASE, which defaults to e." (if base-p @@ -667,12 +680,17 @@ ((double-float (foreach integer ratio single-float double-float)) (%log2 number)) - (((foreach integer ratio single-float) + ((single-float double-float) + (%log2 (float number 1d0))) + ((single-float (foreach integer ratio single-float)) (float (%log2 (float number 1d0)) 1f0)) - (((foreach integer ratio single-float) + (((foreach integer ratio) + (foreach integer ratio single-float)) + (log2 number 1f0)) + (((foreach integer ratio) double-float) - (%log2 (float number 1d0))) + (log2 number 1d0)) #+double-double (((foreach integer ratio single-float double-float) double-double-float) @@ -690,14 +708,19 @@ ;; log base 2 and 10 for non-negative arguments. (number-dispatch ((number real) (base real)) ((double-float - (foreach rational single-float double-float)) + (foreach integer ratio single-float double-float)) (%log10 number)) - (((foreach integer ratio single-float) + ((single-float double-float) + (%log10 (float number 1d0))) + ((single-float (foreach integer ratio single-float)) (float (%log10 (float number 1d0)) 1f0)) - (((foreach integer ratio single-float) + (((foreach integer ratio) + (foreach integer ratio single-float)) + (log10 number 1f0)) + (((foreach integer ratio) double-float) - (%log10 (float number 1d0))) + (log10 number 1d0)) #+double-double (((foreach integer ratio single-float double-float) ext:double-double-float) diff --git a/tests/trac.lisp b/tests/trac.lisp index 2bf420d..198a24d 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -22,7 +22,7 @@ (:tag :trac) (assert-false (let (failures) - (dolist (base (list nil 2 2.0 2d0 + (dolist (base (list nil 2 2.0 2d0 10 10.0 10d0 (ash 1 99) (ash 1 3000) 8/7 (/ (ash 1 3000) 7))) (dolist (number (list 100 100.0 100d0 ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 37 ++++++++++++++++++++++++++++++------- tests/trac.lisp | 2 +- 2 files changed, 31 insertions(+), 8 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-22-g0a522bd
by Raymond Toy 26 Nov '14

26 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 0a522bd0c8c38f6ee76f0cc2122d9984c4e269aa (commit) via cc8c049fe257b28f470baafcf92b6ceb929582de (commit) from 9918ab2d5794ac01efe17b808b351e25519dc88a (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 0a522bd0c8c38f6ee76f0cc2122d9984c4e269aa Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Nov 26 10:24:17 2014 -0800 Use new log2 function in C * code/exports.lisp: * Export %LOG2. * code/irrat.lisp: * Define %log2 * Use %log2 instead of log2. (This needs work) * compiler/float-tran.lisp: * Use %log2 instead of log2 in the deftransforms. diff --git a/src/code/exports.lisp b/src/code/exports.lisp index e75e5d7..99e0762 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -2095,7 +2095,7 @@ "%CALLER-FRAME-AND-PC" "%CHECK-BOUND" "%CLOSURE-FUNCTION" "%CLOSURE-INDEX-REF" "%COS" "%COSH" "%DEPOSIT-FIELD" "%DOUBLE-FLOAT" "%DPB" "%EXP" "%EXPM1" "%HYPOT" "%LDB" - "%LOG" "%LOGB" "%LOG10" "%LOG1P" "%LONG-FLOAT" + "%LOG" "%LOGB" "%LOG10" "%LOG1P" "%LOG2" "%LONG-FLOAT" "%MAKE-COMPLEX" "%MAKE-FUNCALLABLE-INSTANCE" "%MAKE-RATIO" "%MASK-FIELD" "%NEGATE" "%POW" "%RAW-BITS" "%RAW-REF-COMPLEX-DOUBLE" "%RAW-REF-COMPLEX-LONG" diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 1179515..568fa46 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -82,6 +82,7 @@ (def-math-rtn ("__ieee754_exp" %exp) 1) (def-math-rtn ("__ieee754_log" %log) 1) (def-math-rtn ("__ieee754_log10" %log10) 1) +(def-math-rtn ("cmucl_log2" %log2) 1) (def-math-rtn ("__ieee754_pow" %pow) 2) #-(or x86 sparc-v7 sparc-v8 sparc-v9) @@ -665,13 +666,13 @@ (number-dispatch ((number real) (base real)) ((double-float (foreach integer ratio single-float double-float)) - (log2 number)) + (%log2 number)) (((foreach integer ratio single-float) (foreach integer ratio single-float)) - (float (log2 (float number 1d0)) 1f0)) + (float (%log2 (float number 1d0)) 1f0)) (((foreach integer ratio single-float) double-float) - (log2 (float number 1d0))) + (%log2 (float number 1d0))) #+double-double (((foreach integer ratio single-float double-float) double-double-float) diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 6efe701..c30e3f7 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -865,7 +865,7 @@ (cond ((= y-val 10) `(coerce (kernel:%log10 (float x 1d0)) 'single-float)) ((= y-val 2) - `(coerce (kernel::log2 (float x 1d0)) 'single-float))))) + `(coerce (kernel:%log2 (float x 1d0)) 'single-float))))) (deftransform log ((x y) ((or (member 0d0) (double-float 0d0)) (constant-argument number)) @@ -879,7 +879,7 @@ (cond ((= y-val 10) `(kernel:%log10 (float x 1d0))) ((= y-val 2) - `(kernel::log2 (float x 1d0)))))) + `(kernel:%log2 (float x 1d0)))))) ;;; Handle some simple transformations commit cc8c049fe257b28f470baafcf92b6ceb929582de Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Nov 26 10:21:50 2014 -0800 Extract the log2 code out of e_pow.c to implement log2 function. * log2.c: * New file containing the parts of e_pow.c that implemented a log2 function for use in pow(). * GNUmakefile: * Compile log2.c as part of the build. diff --git a/src/lisp/GNUmakefile b/src/lisp/GNUmakefile index d8fb690..f67a20e 100644 --- a/src/lisp/GNUmakefile +++ b/src/lisp/GNUmakefile @@ -13,7 +13,8 @@ FDLIBM = k_sin.c k_cos.c k_tan.c s_sin.c s_cos.c s_tan.c sincos.c \ e_atan2.c \ e_rem_pio2.c k_rem_pio2.c \ e_log10.c s_scalbn.c \ - setexception.c + setexception.c \ + log2.c SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \ vars.c parse.c interrupt.c search.c validate.c globals.c \ diff --git a/src/lisp/log2.c b/src/lisp/log2.c new file mode 100644 index 0000000..d56bc43 --- /dev/null +++ b/src/lisp/log2.c @@ -0,0 +1,139 @@ +/* + * ==================================================== + * Copyright (C) 2004 by Sun Microsystems, Inc. All rights reserved. + * + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +/* + * This is the log2 algorithm pulled out of __ieee754_pow in e_pow.c + */ + +/* + * Method: Let x = 2 * (1+f) + * 1. Compute and return log2(x) in two pieces: + * log2(x) = w1 + w2, + * where w1 has 53-24 = 29 bit trailing zeros. + */ + +#include "fdlibm.h" + +static double +bp[] = {1.0, 1.5,}, +dp_h[] = { 0.0, 5.84962487220764160156e-01,}, /* 0x3FE2B803, 0x40000000 */ +dp_l[] = { 0.0, 1.35003920212974897128e-08,}, /* 0x3E4CFDEB, 0x43CFD006 */ +zero = 0.0, +one = 1.0, +two53 = 9007199254740992.0, /* 0x43400000, 0x00000000 */ + /* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */ +L1 = 5.99999999999994648725e-01, /* 0x3FE33333, 0x33333303 */ +L2 = 4.28571428578550184252e-01, /* 0x3FDB6DB6, 0xDB6FABFF */ +L3 = 3.33333329818377432918e-01, /* 0x3FD55555, 0x518F264D */ +L4 = 2.72728123808534006489e-01, /* 0x3FD17460, 0xA91D4101 */ +L5 = 2.30660745775561754067e-01, /* 0x3FCD864A, 0x93C9DB65 */ +L6 = 2.06975017800338417784e-01, /* 0x3FCA7E28, 0x4A454EEF */ +cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */ +cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */ +cp_l = -7.02846165095275826516e-09; /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/ + +double cmucl_log2(double x) +{ + double ax; + int k, hx, lx, ix; + union { int i[2]; double d; } ux; + + ux.d = x; + hx = ux.i[HIWORD]; lx = ux.i[LOWORD]; + ix = hx&0x7fffffff; + + ax = fabs(x); + + /* special value of x */ + + if (hx < 0x00100000) { /* x < 2**-1022 */ + if (((hx&0x7fffffff)|lx)==0) { + /* log(+-0)=-inf */ + return fdlibm_setexception(-1.0, FDLIBM_DIVIDE_BY_ZERO); + } + + if (hx<0) { + /* log(-#) = NaN */ + return fdlibm_setexception(x, FDLIBM_INVALID); + } + } + + { + double ss,s2,s_h,s_l,t_h,t_l; + double z_h,z_l,p_h,p_l; + double r, u, v, t, t1, t2; + int n, j; + + n = 0; + /* take care subnormal number */ + if(ix<0x00100000) { + ax *= two53; + n -= 53; + ux.d = ax; + ix = ux.i[HIWORD]; + } + n += ((ix)>>20)-0x3ff; + j = ix&0x000fffff; + /* determine interval */ + ix = j|0x3ff00000; /* normalize ix */ + if(j<=0x3988E) k=0; /* |x|<sqrt(3/2) */ + else if(j<0xBB67A) k=1; /* |x|<sqrt(3) */ + else {k=0;n+=1;ix -= 0x00100000;} + ux.d = ax; + ux.i[HIWORD] = ix; + ax = ux.d; + + /* compute ss = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */ + u = ax-bp[k]; /* bp[0]=1.0, bp[1]=1.5 */ + v = one/(ax+bp[k]); + ss = u*v; + s_h = ss; + ux.d = s_h; + ux.i[LOWORD] = 0; + s_h = ux.d; + /* t_h=ax+bp[k] High */ + t_h = zero; + ux.d = t_h; + ux.i[HIWORD]=((ix>>1)|0x20000000)+0x00080000+(k<<18); + t_h = ux.d; + t_l = ax - (t_h-bp[k]); + s_l = v*((u-s_h*t_h)-s_h*t_l); + /* compute log(ax) */ + s2 = ss*ss; + r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6))))); + r += s_l*(s_h+ss); + s2 = s_h*s_h; + t_h = 3.0+s2+r; + ux.d = t_h; + ux.i[LOWORD] = 0; + t_h = ux.d; + t_l = r-((t_h-3.0)-s2); + /* u+v = ss*(1+...) */ + u = s_h*t_h; + v = s_l*t_h+t_l*ss; + /* 2/(3log2)*(ss+...) */ + p_h = u+v; + ux.d = p_h; + ux.i[LOWORD] = 0; + p_h = ux.d; + p_l = v-(p_h-u); + z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */ + z_l = cp_l*p_h+p_l*cp+dp_l[k]; + /* log2(ax) = (ss+..)*2/(3*log2) = n + dp_h + z_h + z_l */ + t = (double)n; + t1 = (((z_h+z_l)+dp_h[k])+t); + ux.d = t1; + ux.i[LOWORD] = 0; + t1 = ux.d; + t2 = z_l-(((t1-t)-dp_h[k])-z_h); + + return t1 + t2; + } +} ----------------------------------------------------------------------- Summary of changes: src/code/exports.lisp | 2 +- src/code/irrat.lisp | 7 ++- src/compiler/float-tran.lisp | 4 +- src/lisp/GNUmakefile | 3 +- src/lisp/log2.c | 139 +++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 148 insertions(+), 7 deletions(-) create mode 100644 src/lisp/log2.c hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-20-g9918ab2
by Raymond Toy 25 Nov '14

25 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 9918ab2d5794ac01efe17b808b351e25519dc88a (commit) via d46a4bfeff75f685f2ccc4a2627a921e46547c1c (commit) via 8e0c67d0c74e1dd5206d2b068734d863440ca286 (commit) from 4d3255aa1a770f59d2851fd2c85707164ca485f5 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 9918ab2d5794ac01efe17b808b351e25519dc88a Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Nov 25 09:35:38 2014 -0800 * Add tests for dd-%log2 and dd-%log10. * Fix the log10.result-types test because we return correctly rounded results for these few tests. diff --git a/tests/irrat.lisp b/tests/irrat.lisp index f1913d3..9538394 100644 --- a/tests/irrat.lisp +++ b/tests/irrat.lisp @@ -5,9 +5,13 @@ (in-package "IRRAT-TESTS") +(defun relerr (actual expected) + (/ (abs (- actual expected)) + expected)) + ;; This tests that log base 2 returns the correct value and the ;; correct type. -(define-test log2 +(define-test log2.result-types (dolist (number '(4 4f0 4d0 #+double-double 4w0)) (dolist (base '(2 2f0 2d0 #+double-double 2w0)) ;; This tests that log returns the correct value and the correct type. @@ -35,54 +39,84 @@ ;; This tests that log base 10 returns the correct value and the ;; correct type. -(define-test log10 +(define-test log10.result-types (dolist (number '(100 100f0 100d0 #+double-double 100w0)) (dolist (base '(10 10f0 10d0 #+double-double 10w0)) ;; This tests that log returns the correct value and the correct type. (let* ((result (log number base)) - (relerr (/ (abs (- result 2)) 2))) - ;; Figure out the expected type of the result and the maximum - ;; allowed relative error. It turns out that for these test - ;; cases, the result is exactly 2 except when the result type - ;; is a double-double-float. In that case, there is a slight - ;; error for (log 100w0 10). - (multiple-value-bind (true-type allowed-error) - (etypecase number - ((or integer single-float) - (etypecase base + (true-type + (etypecase number ((or integer single-float) - (values 'single-float 0)) + (etypecase base + ((or integer single-float) + 'single-float) + (double-float + 'double-float) + #+double-double + (ext:double-double-float + 'ext:double-double-float))) (double-float - (values 'double-float 0)) - #+double-double - (ext:double-double-float - (values 'ext:double-double-float - 7.5d-33)))) - (double-float - (etypecase base - ((or integer single-float double-float) - (values 'double-float 0)) + (etypecase base + ((or integer single-float double-float) + 'double-float) + #+double-double + (ext:double-double-float + 'ext:double-double-float))) #+double-double (ext:double-double-float - (values 'ext:double-double-float - 7.5d-33)))) - #+double-double - (ext:double-double-float - (values 'ext:double-double-float - 7.5d-33))) - (assert-true (<= relerr allowed-error) - number base result relerr allowed-error) - (assert-true (typep result true-type) - number baes result true-type)))))) + 'ext:double-double-float)))) + (assert-equalp 2 result + number base result) + (assert-true (typep result true-type) + number base result true-type))))) -(define-test dd-log2 +(define-test dd-log2.special-cases ;; Verify that for x = 10^k for k = 1 to 300 that (kernel::dd-%log2 ;; x) is close to the expected value. Previously, a bug caused ;; (kernel::dd-%log2 100w0) to give 6.1699... instead of 6.64385. (loop for k from 1 below 300 - and x = (expt 10 k) - and y = (kernel::dd-%log2 (float x 1w0)) - and z = (/ (log (float x 1d0)) (log 2d0)) - and e = (/ (abs (- y z)) z) + for x = (expt 10 k) + for y = (kernel::dd-%log2 (float x 1w0)) + for z = (/ (log (float x 1d0)) (log 2d0)) + for e = (/ (abs (- y z)) z) do (assert-true (<= e 2d-16) - k y z e))) \ No newline at end of file + k y z e)) + (let ((y (kernel::dd-%log2 (sqrt 2w0)))) + (assert-true (<= (relerr y 1/2) + (* 2.7 (scale-float 1d0 (- (float-digits 1w0))))) + y)) + (let ((y (kernel::dd-%log2 (sqrt 0.5w0)))) + (assert-true (<= (relerr y -1/2) + (* 2.7 (scale-float 1d0 (- (float-digits 1w0))))) + y))) + +(define-test dd-log2.powers-of-2 + (loop for k from -1074 below 1024 + for x = (scale-float 1w0 k) + for y = (kernel::dd-%log2 x) + do (assert-equalp k y + k x y))) + +(define-test dd-log10.special-cases + (let ((y (kernel::dd-%log10 (sqrt 10w0)))) + (assert-true (<= (relerr y 1/2) + (* 0.25 (scale-float 1d0 (- (float-digits 1w0)))))))) + +(define-test dd-log10.powers-of-ten + ;; It would be nice if dd-%log10 produce the exact result for powers + ;; of ten, but we currently don't. But note that the maximum + ;; relative error is less than a double-double epsilon. + (let ((threshold (* 0.109 (scale-float 1d0 (- (float-digits 1w0)))))) + (loop for k from -323 below 0 + for x = (expt 10 k) + for y = (kernel::dd-%log10 (float x 1w0)) + for e = (relerr y k) + do (assert-true (<= e threshold) + k e x y)) + (loop for k from 1 to 308 + for x = (expt 10 k) + for y = (kernel::dd-%log10 (float x 1w0)) + for e = (relerr y k) + do (assert-true (<= e threshold) + k e x y)))) + commit d46a4bfeff75f685f2ccc4a2627a921e46547c1c Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Nov 25 09:33:58 2014 -0800 Use log2 and log10 functions when possible instead of using the general case. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index fa89142..1179515 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -653,31 +653,35 @@ ((and (realp number) (realp base)) (cond ((and (= base 2) - (floatp number) - #+double-double - (not (typep number 'ext:double-double-float)) + ;;(floatp number) (or (plusp number) (eql number 0.0) - (eql number 0d0))) - ;; Do the same thing as the deftranform does for - ;; log base 2 and 10 for non-negative arguments. + (eql number 0d0) + #+double-double + (eql number 0w0))) + ;; Do the same thing as the deftranform does for log + ;; base 2 and 10 for non-negative arguments: handle + ;; the case where number > 0 or equal to +0. (number-dispatch ((number real) (base real)) ((double-float - (foreach integer single-float double-float)) + (foreach integer ratio single-float double-float)) (log2 number)) - ((single-float - (foreach integer single-float)) + (((foreach integer ratio single-float) + (foreach integer ratio single-float)) (float (log2 (float number 1d0)) 1f0)) - ((single-float double-float) + (((foreach integer ratio single-float) + double-float) (log2 (float number 1d0))) #+double-double - (((foreach integer single-float double-float) - ext:double-double-float) - (log2 (float number 1w0) base)))) + (((foreach integer ratio single-float double-float) + double-double-float) + (dd-%log2 (float number 1w0))) + #+double-double + ((double-double-float + (foreach integer ratio single-float double-float double-double-float)) + (dd-%log2 number)))) ((and (= base 10) - (floatp number) - #+double-double - (not (typep number 'double-double-float)) + ;;(floatp number) (or (plusp number) (eql number 0.0) (eql number 0d0))) @@ -685,19 +689,22 @@ ;; log base 2 and 10 for non-negative arguments. (number-dispatch ((number real) (base real)) ((double-float - (foreach double-float single-float integer)) + (foreach rational single-float double-float)) (%log10 number)) - ((single-float - (foreach single-float integer)) + (((foreach integer ratio single-float) + (foreach integer ratio single-float)) (float (%log10 (float number 1d0)) 1f0)) - ((single-float double-float) + (((foreach integer ratio single-float) + double-float) (%log10 (float number 1d0))) #+double-double - (((foreach integer single-float double-float) + (((foreach integer ratio single-float double-float) ext:double-double-float) - ;; This could be more accurate! - (/ (log (float number 1w0)) - (log 10w0))))) + (dd-%log10 (float number 1w0))) + #+double-double + ((double-double-float + (foreach integer ratio single-float double-float double-double-float)) + (dd-%log10 number)))) (t ;; CLHS 12.1.4.1 says ;; commit 8e0c67d0c74e1dd5206d2b068734d863440ca286 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Nov 25 09:32:32 2014 -0800 Return -infinity for %log2 and %log10 of +0. diff --git a/src/code/irrat-dd.lisp b/src/code/irrat-dd.lisp index d0acdd7..36051fc 100644 --- a/src/code/irrat-dd.lisp +++ b/src/code/irrat-dd.lisp @@ -1379,6 +1379,9 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 (declare (type double-double-float x) (optimize (speed 3) (space 0) (inhibit-warnings 3))) + (when (eql x 0w0) + ;; log2(+0) = -infinity + (return-from dd-%log2 (/ -1 x))) (multiple-value-bind (e x y z) (compute-log x) ;; Multiply log of fraction by log2(e) and base 2 exponent by 1 @@ -1395,6 +1398,9 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 (declare (type double-double-float x) (optimize (speed 3) (space 0) (inhibit-warnings 3))) + (when (eql x 0w0) + ;; log2(+0) = -infinity + (return-from dd-%log10 (/ -1 x))) (multiple-value-bind (e x y z) (compute-log x) ;; Multiply log of fraction by log10(e) and base 2 exponent by log10(2). ----------------------------------------------------------------------- Summary of changes: src/code/irrat-dd.lisp | 6 +++ src/code/irrat.lisp | 55 ++++++++++++++----------- tests/irrat.lisp | 110 ++++++++++++++++++++++++++++++++----------------- 3 files changed, 109 insertions(+), 62 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-17-g4d3255a
by Raymond Toy 24 Nov '14

24 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 4d3255aa1a770f59d2851fd2c85707164ca485f5 (commit) from 3f063954c98d21ea8a95388d01db96a1e056c34d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 4d3255aa1a770f59d2851fd2c85707164ca485f5 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Nov 24 15:20:12 2014 -0800 Add log10 implementation for double-doubles. Since log2 and log10 use basically the same natural log implementation, factor that out the common part into its own routine. diff --git a/src/code/irrat-dd.lisp b/src/code/irrat-dd.lisp index 45b422e..d0acdd7 100644 --- a/src/code/irrat-dd.lisp +++ b/src/code/irrat-dd.lisp @@ -44,6 +44,20 @@ 4.4269504088896340735992468100189213742664595w-1 _N"log2(e)-1") +;; l102a+log102b = log10(2) to extra precision +(defconstant l102a + 0.3125w0) + +(defconstant l102b + -1.14700043360188047862611052755069732318101185w-2) + +;; l10ea + l10eb = log10(2) to extra precsion +(defconstant l10ea + 0.5w0) + +(defconstant l10eb + -6.570551809674817234887108108339491770560299w-2) + (defconstant dd-pi 3.141592653589793238462643383279502884197169w0 _N"Pi") @@ -1241,8 +1255,8 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 (values (- (dd-%%cos reduced)) (dd-%%sin reduced)))))))) -;;; dd-%log2 -;;; Base 2 logarithm. +;;; dd-%log2 and dd-%log10 +;;; Base 2 and base 10 logarithm. ;;; ;;; The argument is separated into its exponent and fractional ;;; parts. If the exponent is between -1 and +1, the (natural) @@ -1254,6 +1268,9 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ;;; ;;; log(x) = z + z**3 R(z)/S(z). ;;; +;;; This gives the natural log. To get the base 2 and base 10 log, +;;; carefully multiply the natural log by log2(e) or log10(e) as +;;; appropriate. (let ((P (make-array 13 :element-type 'double-double-float :initial-contents '( @@ -1314,52 +1331,82 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 -1.332535117259762928288745111081235577029w6 1.701761051846631278975701529965589676574w6 )))) + (flet + ((compute-log (x) + ;; Common routine to extract the exponent and fraction from x + ;; and compute the log(f). Return the exponent, the fraction, + ;; and the parts of the polynomial computation that is needed + ;; to finish off the final logarithm. + (declare (type double-double-float x) + (optimize (speed 3) (space 0) + (inhibit-warnings 3))) + (multiple-value-bind (x e) + (decode-float x) + (declare (type double-double-float x) + (type double-float-exponent e)) + (let ((z 0w0) + (y 0w0)) + (declare (type double-double-float z y)) + (cond ((or (> e 2) + (< e -2)) + (cond ((< x sqrt-1/2) + ;; 2*(2*x-1)/(2*x+1) + (decf e) + (setf z (- x 0.5w0)) + (setf y (+ (* 0.5w0 z) 0.5w0))) + (t + ;; 2*(x-1)/(x+1) + (setf z (- x 0.5w0)) + (decf z 0.5w0) + (setf y (+ (* 0.5w0 x) 0.5w0)))) + (setf x (/ z y)) + (setf z (* x x)) + (setf y (* x (/ (* z (poly-eval z r)) + (poly-eval-1 z s))))) + (t + (cond ((< x sqrt-1/2) + (decf e) + (setf x (- (scale-float x 1) 1))) + (t + (decf x))) + (setf z (* x x)) + (setf y (* x (/ (* z (poly-eval x p)) + (poly-eval-1 x q)))) + (decf y (scale-float z -1)))) + (values e x y z))))) + (defun dd-%log2 (x) (declare (type double-double-float x) (optimize (speed 3) (space 0) (inhibit-warnings 3))) - (multiple-value-bind (x e) - (decode-float x) - (declare (type double-double-float x) - (type double-float-exponent e)) - (let ((z 0w0) - (y 0w0)) - (declare (type double-double-float z y)) - (cond ((or (> e 2) - (< e -2)) - (cond ((< x sqrt-1/2) - ;; 2*(2*x-1)/(2*x+1) - (decf e) - (setf z (- x 0.5w0)) - (setf y (+ (* 0.5w0 z) 0.5w0))) - (t - ;; 2*(x-1)/(x+1) - (setf z (- x 0.5w0)) - (decf z 0.5w0) - (setf y (+ (* 0.5w0 x) 0.5w0)))) - (setf x (/ z y)) - (setf z (* x x)) - (setf y (* x (/ (* z (poly-eval z r)) - (poly-eval-1 z s))))) - (t - (cond ((< x sqrt-1/2) - (decf e) - (setf x (- (scale-float x 1) 1))) - (t - (decf x))) - (setf z (* x x)) - (setf y (* x (/ (* z (poly-eval x p)) - (poly-eval-1 x q)))) - (decf y (scale-float z -1)))) - ;; Multiply log of fraction by log2(e) and base 2 exponent by 1 - ;; - ;; This sequence of operations is critical - (setf z (* y log2ea)) - (setf z (+ z (* x log2ea))) - (setf z (+ z y)) - (setf z (+ z x)) - (setf z (+ z e)) - z)))) + (multiple-value-bind (e x y z) + (compute-log x) + ;; Multiply log of fraction by log2(e) and base 2 exponent by 1 + ;; + ;; This sequence of operations is critical + (setf z (* y log2ea)) + (incf z (* x log2ea)) + (incf z y) + (incf z x) + (incf z e) + z)) + + (defun dd-%log10 (x) + (declare (type double-double-float x) + (optimize (speed 3) (space 0) + (inhibit-warnings 3))) + (multiple-value-bind (e x y z) + (compute-log x) + ;; Multiply log of fraction by log10(e) and base 2 exponent by log10(2). + ;; + ;; This sequence of operations is critical. + (setf z (* y l10eb)) + (incf z (* x l10eb)) + (incf z (* e l102b)) + (incf z (* y l10ea)) + (incf z (* x l10ea)) + (incf z (* e l102a)) + z)))) ;;; dd-%exp2 ;;; 2^x ----------------------------------------------------------------------- Summary of changes: src/code/irrat-dd.lisp | 135 +++++++++++++++++++++++++++++++++---------------- 1 file changed, 91 insertions(+), 44 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-16-g3f06395
by Raymond Toy 24 Nov '14

24 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 3f063954c98d21ea8a95388d01db96a1e056c34d (commit) via a932491bb20a7e2a05cce1bd142870f2a6edfcad (commit) via d36c032a5440e1f2a5e2bbda37962a2a96c6aaac (commit) from 31f691c9565941b4c04309b16a871860246c29e1 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 3f063954c98d21ea8a95388d01db96a1e056c34d Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Nov 24 13:41:00 2014 -0800 Fix bug in dd-%log2 where (dd-%log2 100w0) returned 6.16 instead of 6.64. Tests were already added to tests/irrat.lisp. diff --git a/src/code/irrat-dd.lisp b/src/code/irrat-dd.lisp index 438339f..45b422e 100644 --- a/src/code/irrat-dd.lisp +++ b/src/code/irrat-dd.lisp @@ -1243,7 +1243,17 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ;;; dd-%log2 ;;; Base 2 logarithm. - +;;; +;;; The argument is separated into its exponent and fractional +;;; parts. If the exponent is between -1 and +1, the (natural) +;;; logarithm of the fraction is approximated by +;;; +;;; log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). +;;; +;;; Otherwise, setting z = 2(x-1)/x+1), +;;; +;;; log(x) = z + z**3 R(z)/S(z). +;;; (let ((P (make-array 13 :element-type 'double-double-float :initial-contents '( @@ -1326,7 +1336,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ;; 2*(x-1)/(x+1) (setf z (- x 0.5w0)) (decf z 0.5w0) - (setf y (+ (* 0.5w0 z) 0.5w0)))) + (setf y (+ (* 0.5w0 x) 0.5w0)))) (setf x (/ z y)) (setf z (* x x)) (setf y (* x (/ (* z (poly-eval z r)) commit a932491bb20a7e2a05cce1bd142870f2a6edfcad Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Nov 24 13:39:37 2014 -0800 Add tests for log2 and log10. diff --git a/tests/irrat.lisp b/tests/irrat.lisp new file mode 100644 index 0000000..f1913d3 --- /dev/null +++ b/tests/irrat.lisp @@ -0,0 +1,88 @@ +;; Tests of special irrational functions + +(defpackage :irrat-tests + (:use :cl :lisp-unit)) + +(in-package "IRRAT-TESTS") + +;; This tests that log base 2 returns the correct value and the +;; correct type. +(define-test log2 + (dolist (number '(4 4f0 4d0 #+double-double 4w0)) + (dolist (base '(2 2f0 2d0 #+double-double 2w0)) + ;; This tests that log returns the correct value and the correct type. + (let* ((result (log number base)) + (true-type (etypecase number + ((or integer single-float) + (etypecase base + ((or integer single-float) 'single-float) + (double-float 'double-float) + #+double-double + (ext:double-double-float 'ext:double-double-float))) + (double-float + (etypecase base + ((or integer single-float double-float) + 'double-float) + #+double-double + (ext:double-double-float 'ext:double-double-float))) + #+double-double + (ext:double-double-float + 'ext:double-double-float)))) + (assert-equal (coerce 2 true-type) result + number base) + (assert-true (typep result true-type) + result true-type))))) + +;; This tests that log base 10 returns the correct value and the +;; correct type. +(define-test log10 + (dolist (number '(100 100f0 100d0 #+double-double 100w0)) + (dolist (base '(10 10f0 10d0 #+double-double 10w0)) + ;; This tests that log returns the correct value and the correct type. + (let* ((result (log number base)) + (relerr (/ (abs (- result 2)) 2))) + ;; Figure out the expected type of the result and the maximum + ;; allowed relative error. It turns out that for these test + ;; cases, the result is exactly 2 except when the result type + ;; is a double-double-float. In that case, there is a slight + ;; error for (log 100w0 10). + (multiple-value-bind (true-type allowed-error) + (etypecase number + ((or integer single-float) + (etypecase base + ((or integer single-float) + (values 'single-float 0)) + (double-float + (values 'double-float 0)) + #+double-double + (ext:double-double-float + (values 'ext:double-double-float + 7.5d-33)))) + (double-float + (etypecase base + ((or integer single-float double-float) + (values 'double-float 0)) + #+double-double + (ext:double-double-float + (values 'ext:double-double-float + 7.5d-33)))) + #+double-double + (ext:double-double-float + (values 'ext:double-double-float + 7.5d-33))) + (assert-true (<= relerr allowed-error) + number base result relerr allowed-error) + (assert-true (typep result true-type) + number baes result true-type)))))) + +(define-test dd-log2 + ;; Verify that for x = 10^k for k = 1 to 300 that (kernel::dd-%log2 + ;; x) is close to the expected value. Previously, a bug caused + ;; (kernel::dd-%log2 100w0) to give 6.1699... instead of 6.64385. + (loop for k from 1 below 300 + and x = (expt 10 k) + and y = (kernel::dd-%log2 (float x 1w0)) + and z = (/ (log (float x 1d0)) (log 2d0)) + and e = (/ (abs (- y z)) z) + do (assert-true (<= e 2d-16) + k y z e))) \ No newline at end of file commit d36c032a5440e1f2a5e2bbda37962a2a96c6aaac Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Nov 24 11:45:00 2014 -0800 Regenerate. diff --git a/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po b/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po index df7d5b1..6eb9404 100644 --- a/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po @@ -5177,6 +5177,29 @@ msgstr "" " urrogatesay aluevay, espectivelyray." #: src/code/string.lisp +#, fuzzy +msgid "" +"WITH-STRING-CODEPOINT-ITERATOR ((next string) &body body)\n" +" provides a method of looping through a string from the beginning to\n" +" the end of the string prodcucing successive codepoints from the\n" +" string. NEXT is bound to a generator macro that, within the scope\n" +" of the invocation, returns one or two values. The first value tells\n" +" whether any objects remain in the string. When the first value is\n" +" non-NIL, the second value is the codepoint of the next object." +msgstr "" +"WITH-HASH-TABLE-ITERATOR ((unctionfay ashhay-abletay) &odybay odybay)\n" +" ovidespray away ethodmay ofway anuallymay oopinglay overway ethay " +"elementsway ofway away ashhay-abletay.\n" +" FUNCTION isway oundbay otay away eneratorgay-acromay atthay, ithinway " +"ethay opescay ofway ethay\n" +" invocationway, eturnsray oneway orway reethay aluesvay. Ethay irstfay " +"aluevay ellstay etherwhay\n" +" anyway objectsway emainray inway ethay ashhay abletay. Enwhay ethay " +"irstfay aluevay isway onnay-NIL, \n" +" ethay econdsay andway irdthay aluesvay areway ethay eykay andway ethay " +"aluevay ofway ethay extnay objectway." + +#: src/code/string.lisp msgid "" "Return the high and low surrogate characters for Codepoint. If\n" " Codepoint is in the BMP, the first return value is the corresponding\n" @@ -5620,6 +5643,30 @@ msgstr "" " exceptway atthay ethay ingstray ustmay ebay away implesay-ingstray" #: src/code/string.lisp +#, fuzzy +msgid "" +"WITH-STRING-GLYPH-ITERATOR ((next string) &body body)\n" +" provides a method of looping through a string from the beginning to\n" +" the end of the string prodcucing successive glyphs from the string.\n" +" NEXT is bound to a generator macro that, within the scope of the\n" +" invocation, returns one or three values. The first value tells\n" +" whether any objects remain in the string. When the first value is\n" +" non-NIL, the second value is the index into the string of the glyph\n" +" and the third value is index of the next glyph." +msgstr "" +"WITH-HASH-TABLE-ITERATOR ((unctionfay ashhay-abletay) &odybay odybay)\n" +" ovidespray away ethodmay ofway anuallymay oopinglay overway ethay " +"elementsway ofway away ashhay-abletay.\n" +" FUNCTION isway oundbay otay away eneratorgay-acromay atthay, ithinway " +"ethay opescay ofway ethay\n" +" invocationway, eturnsray oneway orway reethay aluesvay. Ethay irstfay " +"aluevay ellstay etherwhay\n" +" anyway objectsway emainray inway ethay ashhay abletay. Enwhay ethay " +"irstfay aluevay isway onnay-NIL, \n" +" ethay econdsay andway irdthay aluesvay areway ethay eykay andway ethay " +"aluevay ofway ethay extnay objectway." + +#: src/code/string.lisp msgid "" "Convert String to Unicode Normalization Form D (NFD) using the\n" " canonical decomposition. The NFD string is returned" @@ -19092,6 +19139,18 @@ msgid "Destructuring is not valid for package symbol iteration." msgstr "" "Estructuringday isway otnay alidvay orfay ackagepay ymbolsay iterationway." +#: src/code/loop.lisp +#, fuzzy +msgid "Destructuring is not valid for string codepoint iteration." +msgstr "" +"Estructuringday isway otnay alidvay orfay ackagepay ymbolsay iterationway." + +#: src/code/loop.lisp +#, fuzzy +msgid "Destructuring is not valid for string glyph iteration." +msgstr "" +"Estructuringday isway otnay alidvay orfay ackagepay ymbolsay iterationway." + #: src/code/stream-vector-io.lisp msgid "endian-swap ~a is illegal for element-type of vector ~a" msgstr "" diff --git a/src/i18n/locale/ko/LC_MESSAGES/cmucl.po b/src/i18n/locale/ko/LC_MESSAGES/cmucl.po index b73bf6a..a8c6a23 100644 --- a/src/i18n/locale/ko/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/ko/LC_MESSAGES/cmucl.po @@ -3704,6 +3704,17 @@ msgstr "" #: src/code/string.lisp msgid "" +"WITH-STRING-CODEPOINT-ITERATOR ((next string) &body body)\n" +" provides a method of looping through a string from the beginning to\n" +" the end of the string prodcucing successive codepoints from the\n" +" string. NEXT is bound to a generator macro that, within the scope\n" +" of the invocation, returns one or two values. The first value tells\n" +" whether any objects remain in the string. When the first value is\n" +" non-NIL, the second value is the codepoint of the next object." +msgstr "" + +#: src/code/string.lisp +msgid "" "Return the high and low surrogate characters for Codepoint. If\n" " Codepoint is in the BMP, the first return value is the corresponding\n" " character and the second is NIL." @@ -3962,6 +3973,18 @@ msgstr "" #: src/code/string.lisp msgid "" +"WITH-STRING-GLYPH-ITERATOR ((next string) &body body)\n" +" provides a method of looping through a string from the beginning to\n" +" the end of the string prodcucing successive glyphs from the string.\n" +" NEXT is bound to a generator macro that, within the scope of the\n" +" invocation, returns one or three values. The first value tells\n" +" whether any objects remain in the string. When the first value is\n" +" non-NIL, the second value is the index into the string of the glyph\n" +" and the third value is index of the next glyph." +msgstr "" + +#: src/code/string.lisp +msgid "" "Convert String to Unicode Normalization Form D (NFD) using the\n" " canonical decomposition. The NFD string is returned" msgstr "" @@ -13414,6 +13437,14 @@ msgstr "" msgid "Destructuring is not valid for package symbol iteration." msgstr "" +#: src/code/loop.lisp +msgid "Destructuring is not valid for string codepoint iteration." +msgstr "" + +#: src/code/loop.lisp +msgid "Destructuring is not valid for string glyph iteration." +msgstr "" + #: src/code/stream-vector-io.lisp msgid "endian-swap ~a is illegal for element-type of vector ~a" msgstr "" ----------------------------------------------------------------------- Summary of changes: src/code/irrat-dd.lisp | 14 +++- src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po | 59 ++++++++++++++++ src/i18n/locale/ko/LC_MESSAGES/cmucl.po | 31 +++++++++ tests/irrat.lisp | 88 ++++++++++++++++++++++++ 4 files changed, 190 insertions(+), 2 deletions(-) create mode 100644 tests/irrat.lisp hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-13-g31f691c
by Raymond Toy 24 Nov '14

24 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via 31f691c9565941b4c04309b16a871860246c29e1 (commit) from ea433981ca884c40c90578dd891f37505618ac76 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 31f691c9565941b4c04309b16a871860246c29e1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Mon Nov 24 11:31:11 2014 -0800 Fix error in computation (log number base) where one of the args is a double-double. * src/code/irrat.lisp: * For the following two cases, cmucl generated an error instead of computing the log * Base is a double-double but number is not. * Number is a double-double but base is not. * tests/irrat.lisp: * Add some tests for log2 and log10. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 8ddd413..fa89142 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -669,7 +669,11 @@ (foreach integer single-float)) (float (log2 (float number 1d0)) 1f0)) ((single-float double-float) - (log2 (float number 1d0))))) + (log2 (float number 1d0))) + #+double-double + (((foreach integer single-float double-float) + ext:double-double-float) + (log2 (float number 1w0) base)))) ((and (= base 10) (floatp number) #+double-double @@ -687,7 +691,13 @@ (foreach single-float integer)) (float (%log10 (float number 1d0)) 1f0)) ((single-float double-float) - (%log10 (float number 1d0))))) + (%log10 (float number 1d0))) + #+double-double + (((foreach integer single-float double-float) + ext:double-double-float) + ;; This could be more accurate! + (/ (log (float number 1w0)) + (log 10w0))))) (t ;; CLHS 12.1.4.1 says ;; @@ -729,11 +739,14 @@ #+double-double ((double-double-float (foreach fixnum bignum ratio)) + ;; Use log2 in case the base is so large that it + ;; won't fit in a float. (/ (log2 number 1w0) (log2 base 1w0))) #+double-double ((double-double-float (foreach double-double-float double-float single-float)) - (/ (log number) (log (coerce base 'double-double-float)))) + (/ (log number) + (log (coerce base 'double-double-float)))) #+double-double (((foreach fixnum bignum ratio) double-double-float) ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-11-12-gea43398
by Raymond Toy 22 Nov '14

22 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via ea433981ca884c40c90578dd891f37505618ac76 (commit) via f2fd2ab4ebbecf9ab08dcb30ca62100ada3f6400 (commit) from eab088ab2774b7819edb431c2cdf25cec974b40e (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit ea433981ca884c40c90578dd891f37505618ac76 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Sat Nov 22 10:58:35 2014 -0800 Don't need to compile undefineds.c on sparc. diff --git a/src/lisp/Config.sparc_common b/src/lisp/Config.sparc_common index 9a7c850..55204c0 100644 --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -60,6 +60,6 @@ ASSEM_SRC = sparc-assem.S ARCH_SRC = sparc-arch.c DEPEND=$(CC) -OS_SRC = solaris-os.c os-common.c undefineds.c elf.c +OS_SRC = solaris-os.c os-common.c elf.c OS_LIBS= -lsocket -lnsl -ldl EXEC_FINAL_OBJ = exec-final.o ----------------------------------------------------------------------- Summary of changes: src/code/filesys.lisp | 9 ++++----- src/lisp/Config.sparc_common | 2 +- 2 files changed, 5 insertions(+), 6 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-unix-core updated. snapshot-2014-11-18-gdb12154
by Raymond Toy 19 Nov '14

19 Nov '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, rtoy-unix-core has been updated via db12154da8871000bdfd64e4b11e0a54b9f36d07 (commit) from 11ecbb802bbf4758df3e4f0e45faeb912bcc1e72 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit db12154da8871000bdfd64e4b11e0a54b9f36d07 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Nov 18 21:35:46 2014 -0800 Add UNIX-SYMLINK. This allows the testsuite to run. Tests behave as expected. diff --git a/src/code/exports.lisp b/src/code/exports.lisp index 197af66..4bd2140 100644 --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -294,6 +294,9 @@ "UNIX-FCHMOD" "UNIX-CREAT" "UNIX-UTIMES" + + ;; Tests + "UNIX-SYMLINK" )) (defpackage "FORMAT") diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 968194c..7ccf98f 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -1884,6 +1884,14 @@ nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf) (if to-secs (alien-sap (addr tv)) (int-sap 0)))))) +(defun unix-symlink (name1 name2) + _N"Unix-symlink creates a symbolic link named name2 to the file + named name1. NIL and an error number is returned if the call + is unsuccessful." + (declare (type unix-pathname name1 name2)) + (void-syscall ("symlink" c-string c-string) + (%name->file name1) (%name->file name2))) + (def-alien-type nil (struct timeval (tv-sec #-linux time-t #+linux int) ; seconds ----------------------------------------------------------------------- Summary of changes: src/code/exports.lisp | 3 +++ src/code/unix.lisp | 8 ++++++++ 2 files changed, 11 insertions(+) hooks/post-receive -- CMU Common Lisp

1 0