[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2014-11-16-g3f06395

Raymond Toy rtoy at common-lisp.net
Mon Nov 24 21:41:07 UTC 2014


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 at 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 at 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 at gmail.com>
Date:   Mon Nov 24 11:45:00 2014 -0800

    Regenerate.

diff --git a/src/i18n/locale/en at piglatin/LC_MESSAGES/cmucl.po b/src/i18n/locale/en at piglatin/LC_MESSAGES/cmucl.po
index df7d5b1..6eb9404 100644
--- a/src/i18n/locale/en at piglatin/LC_MESSAGES/cmucl.po
+++ b/src/i18n/locale/en at 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 at 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


More information about the cmucl-commit mailing list