[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-14-g106bf4f

Raymond Toy rtoy at lisp.not.org
Thu Sep 25 02:53:19 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  106bf4fc7687741b27523b23db3c9b2443237b2d (commit)
      from  db25e3e006f90d031ecca30aa1b04e77fc1be619 (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 106bf4fc7687741b27523b23db3c9b2443237b2d
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Wed Sep 24 19:53:07 2014 -0700

    Make the LOG function match what the deftransform for LOG does.
    
    Without this, compiled code produces different answers from
    interpreted code.
    
     * src/code/irrat.lisp:
       * Add cases where the base is 2 or 10 to compute the log in the
         same way as the deftransform for LOG does.
     * tests/float.lisp:
       * Fix comparison to use equalp, not equal.
       * Add test for log10.

diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index 61d4314..daf6166 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -645,74 +645,112 @@
 	     ;; ANSI spec
 	     base)
 	    ((and (realp number) (realp base))
-	     ;; CLHS 12.1.4.1 says
-	     ;;
-	     ;;   When rationals and floats are combined by a
-	     ;;   numerical function, the rational is first converted
-	     ;;   to a float of the same format.
-	     ;;
-	     ;; So assume this applies to floats as well convert all
-	     ;; numbers to the largest float format before computing
-	     ;; the log.
-	     ;;
-	     ;; This makes (log 17 10.0) = (log 17.0 10) and so on.
-	     (number-dispatch ((number real) (base real))
-	       ((double-float
-		 (foreach double-float single-float))
-		(/ (log2 number) (log2 base)))
-	       (((foreach fixnum bignum ratio)
-		 (foreach fixnum bignum ratio single-float))
-		(let* ((result (/ (log2 number) (log2 base))))
-		  ;; Figure out the right result type
-		  (if (realp result)
-		      (coerce result 'single-float)
-		      (coerce result '(complex single-float)))))
-	       (((foreach fixnum bignum ratio)
-		 double-float)
-		(/ (log2 number) (log2 base)))
-	       ((single-float
-		 (foreach fixnum bignum ratio))
-		(let* ((result (/ (log2 number) (log2 base))))
-		  ;; Figure out the right result type
-		  (if (realp result)
-		      (coerce result 'single-float)
-		      (coerce result '(complex single-float)))))
-	       ((double-float
-		 (foreach fixnum bignum ratio))
-		(/ (log2 number) (log2 base)))
-	       ((single-float double-float)
-		(/ (log (coerce number 'double-float)) (log base)))
-	       #+double-double
-	       ((double-double-float
-		 (foreach fixnum bignum ratio))
-		(/ (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))))
-	       #+double-double
-	       (((foreach fixnum bignum ratio)
-		 double-double-float)
-		(/ (log2 number 1w0) (log2 base 1w0)))
-	       #+double-double
-	       (((foreach double-float single-float)
-		 double-double-float)
-		(/ (log (coerce number 'double-double-float)) (log base)))
-	       (((foreach single-float)
-		 (foreach single-float))
-		;; Converting everything to double-float helps the
-		;; cases like (log 17 10) = (/ (log 17) (log 10)).
-		;; This is usually handled above, but if we compute (/
-		;; (log 17) (log 10)), we get a slightly different
-		;; answer due to roundoff.  This makes it a bit more
-		;; consistent.
+	     (cond
+	       ((and (= base 2)
+		     (floatp number)
+		     #+double-double
+		     (not (typep number 'ext:double-double-float))
+		     (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.
+		(number-dispatch ((number real) (base real))
+		  ((double-float
+		    (foreach integer single-float double-float))
+		   (log2 number))
+		  ((single-float
+		    (foreach integer single-float))
+		   (float (log2 (float number 1d0)) 1f0))
+		  ((single-float double-float)
+		   (log2 (float number 1d0)))))
+	       ((and (= base 10)
+		     (floatp number)
+		     #+double-double
+		     (not (typep number 'double-double-float))
+		     (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.
+		(number-dispatch ((number real) (base real))
+		  ((double-float
+		    (foreach double-float single-float integer))
+		   (%log10 number))
+		  ((single-float
+		    (foreach single-float integer))
+		   (float (%log10 (float number 1d0)) 1f0))
+		  ((single-float double-float)
+		   (%log10 (float number 1d0)))))
+	       (t
+		;; CLHS 12.1.4.1 says
+		;;
+		;;   When rationals and floats are combined by a
+		;;   numerical function, the rational is first converted
+		;;   to a float of the same format.
+		;;
+		;; So assume this applies to floats as well convert all
+		;; numbers to the largest float format before computing
+		;; the log.
 		;;
-		;; FIXME: This probably needs more work.
-		(let ((result (/ (log (float number 1d0))
-				 (log (float base 1d0)))))
-		  (if (realp result)
-		      (coerce result 'single-float)
-		      (coerce result '(complex single-float)))))))
+		;; This makes (log 17 10.0) = (log 17.0 10) and so on.
+		(number-dispatch ((number real) (base real))
+		  ((double-float
+		    (foreach double-float single-float))
+		   (/ (log2 number) (log2 base)))
+		  (((foreach fixnum bignum ratio)
+		    (foreach fixnum bignum ratio single-float))
+		   (let* ((result (/ (log2 number) (log2 base))))
+		     ;; Figure out the right result type
+		     (if (realp result)
+			 (coerce result 'single-float)
+			 (coerce result '(complex single-float)))))
+		  (((foreach fixnum bignum ratio)
+		    double-float)
+		   (/ (log2 number) (log2 base)))
+		  ((single-float
+		    (foreach fixnum bignum ratio))
+		   (let* ((result (/ (log2 number) (log2 base))))
+		     ;; Figure out the right result type
+		     (if (realp result)
+			 (coerce result 'single-float)
+			 (coerce result '(complex single-float)))))
+		  ((double-float
+		    (foreach fixnum bignum ratio))
+		   (/ (log2 number) (log2 base)))
+		  ((single-float double-float)
+		   (/ (log (coerce number 'double-float)) (log base)))
+		  #+double-double
+		  ((double-double-float
+		    (foreach fixnum bignum ratio))
+		   (/ (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))))
+		  #+double-double
+		  (((foreach fixnum bignum ratio)
+		    double-double-float)
+		   (/ (log2 number 1w0) (log2 base 1w0)))
+		  #+double-double
+		  (((foreach double-float single-float)
+		    double-double-float)
+		   (/ (log (coerce number 'double-double-float)) (log base)))
+		  (((foreach single-float)
+		    (foreach single-float))
+		   ;; Converting everything to double-float helps the
+		   ;; cases like (log 17 10) = (/ (log 17) (log 10)).
+		   ;; This is usually handled above, but if we compute (/
+		   ;; (log 17) (log 10)), we get a slightly different
+		   ;; answer due to roundoff.  This makes it a bit more
+		   ;; consistent.
+		   ;;
+		   ;; FIXME: This probably needs more work.
+		   (let ((result (/ (log (float number 1d0))
+				    (log (float base 1d0)))))
+		     (if (realp result)
+			 (coerce result 'single-float)
+			 (coerce result '(complex single-float)))))))))
 	    (t
 	     ;; FIXME:  This probably needs some work as well.
 	     (/ (log number) (log base))))
diff --git a/tests/float.lisp b/tests/float.lisp
index ff07270..eeb221b 100644
--- a/tests/float.lisp
+++ b/tests/float.lisp
@@ -11,7 +11,13 @@
 					 (decode-float x)))
 			1d0)))
 
-(define-test log2
+(define-test log2.interp
   (loop for k from -1074 to 1023 do
     (let ((x (scale-float 1d0 k)))
-      (assert-equal k (log x 2)))))
+      (assert-equalp k (log x 2)))))
+
+(define-test log10.interp
+  (loop for k from 0 to 22 do
+    (let ((x (float (expt 10 k) 1d0)))
+      (assert-equalp k (log x 10)))))
+

-----------------------------------------------------------------------

Summary of changes:
 src/code/irrat.lisp |  172 +++++++++++++++++++++++++++++++--------------------
 tests/float.lisp    |   10 ++-
 2 files changed, 113 insertions(+), 69 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp




More information about the cmucl-cvs mailing list