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

[Raymond Toy]

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 at 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