[git] CMU Common Lisp branch master updated. snapshot-2014-09-13-gdb25e3e

Raymond Toy rtoy at common-lisp.net
Sun Sep 21 00:59:27 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  db25e3e006f90d031ecca30aa1b04e77fc1be619 (commit)
      from  24511623e8c3ba1752339d2613bbd18ef27859b0 (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 db25e3e006f90d031ecca30aa1b04e77fc1be619
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Sat Sep 20 17:59:16 2014 -0700

    Add deftransform to convert (log x 2) and (log x 10) to log2 and
    %log10. This better than using the definition (/ (log x) (log base)).
    This also allows exact answer for 2^n and 10^n for appropriate n.
    
    
     * src/compiler/float-tran.lisp:
       * Add deftransforms to convert (log x 2) and (log x 10) to
         kernel::log2 and kernel:%log10
     * tests/float-tran.lisp:
       * Add tests to check the transforms are done, or not done, as
         appropriate.

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 4aecd5c..f474429 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -824,6 +824,33 @@
 (deftransform log ((x y) (float float) float)
   '(if (zerop y) y (/ (log x) (log y))))
 
+(deftransform log ((x y) ((or (member 0f0) (single-float (0f0)))
+			  (constant-argument number))
+		   single-float)
+  ;; Transform (log x 2) and (log x 10) to something simpler.
+  (let ((y-val (continuation-value y)))
+    (unless (and (not-more-contagious y x)
+		 (or (= y-val 2)
+		     (= y-val 10)))
+      (give-up))
+    (cond ((= y-val 10)
+	   `(coerce (kernel:%log10 (float x 1d0)) 'single-float))
+	  ((= y-val 2)
+	   `(coerce (kernel::log2 (float x 1d0)) 'single-float)))))
+
+(deftransform log ((x y) ((or (member 0d0) (double-float 0d0))
+			  (constant-argument number))
+		   double-float)
+  ;; Transform (log x 2) and (log x 10) to something simpler.
+  (let ((y-val (continuation-value y)))
+    (unless (and (not-more-contagious y x)
+		 (or (= y-val 2)
+		     (= y-val 10)))
+      (give-up))
+    (cond ((= y-val 10)
+	   `(kernel:%log10 (float x 1d0)))
+	  ((= y-val 2)
+	   `(kernel::log2 (float x 1d0))))))
 
 ;;; Handle some simple transformations
   
diff --git a/tests/float-tran.lisp b/tests/float-tran.lisp
index 9c81882..0c47dce 100644
--- a/tests/float-tran.lisp
+++ b/tests/float-tran.lisp
@@ -8,10 +8,131 @@
 (define-test decode-float-sign
   "Test type derivation of the sign from decode-float"
   (assert-equalp (c::make-member-type :members (list 1f0 -1f0))
-		 (c::decode-float-sign-derive-type-aux (c::specifier-type 'single-float)))
+		 (c::decode-float-sign-derive-type-aux
+		  (c::specifier-type 'single-float)))
   (assert-equalp (c::make-member-type :members (list 1d0 -1d0))
-		 (c::decode-float-sign-derive-type-aux (c::specifier-type 'double-float)))
+		 (c::decode-float-sign-derive-type-aux
+		  (c::specifier-type 'double-float)))
   (assert-equalp (c::make-member-type :members (list 1f0))
-		 (c::decode-float-sign-derive-type-aux (c::specifier-type '(single-float (0f0))))))
+		 (c::decode-float-sign-derive-type-aux
+		  (c::specifier-type '(single-float (0f0))))))
 
-  
\ No newline at end of file
+(define-test log2-single-transform
+  "Test tranform of (log x 2) to (kernel::log2 x)"
+  (let ((test-fun
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (single-float (0f0)) x))
+		     (log x 2)))))
+    ;; test-fun should have transformed (log x 2) to kernel::log2
+    (assert-true (search "log2" (with-output-to-string (*standard-output*)
+				  (disassemble test-fun)))))
+  (let ((test-fun
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (single-float 0f0) x))
+		     (log x 2)))))
+    ;; test-fun should not have transformed (log x 2) to kernel::log2
+    ;; because x can be -0 for which log should return a complex
+    ;; result.
+    (assert-false (search "log2" (with-output-to-string (*standard-output*)
+				   (disassemble test-fun)))))
+  (let ((test-fun
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (single-float 0f0) x))
+		     (log x 2d0)))))
+    ;; test-fun should not have transformed (log x 2) to kernel::log2
+    ;; because the result should be a double due to floating-point
+    ;; contagion.
+    (assert-false (search "log2" (with-output-to-string (*standard-output*)
+				   (disassemble test-fun))))))
+
+(define-test log2-double-transform
+  "Test tranform of (log x 2) to (kernel::log2 x)"
+  (let ((test-fun-good
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (double-float (0d0)) x))
+		     (log x 2)))))
+    ;; test-fun should have transformed (log x 2) to kernel::log2
+    (assert-true (search "log2" (with-output-to-string (*standard-output*)
+				  (disassemble test-fun-good)))))
+  (let ((test-fun-bad
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (double-float 0d0) x))
+		     (log x 2)))))
+    ;; test-fun should not have transformed (log x 2) to kernel::log2
+    ;; because x can be -0 for which log should return a complex
+    ;; result.
+    (assert-false (search "log2" (with-output-to-string (*standard-output*)
+				   (disassemble test-fun-bad)))))
+  (let ((test-fun-good-2
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (double-float (0d0)) x))
+		     (log x 2f0)))))
+    ;; test-fun should have transformed (log x 2) to kernel::log2
+    (assert-true (search "log2" (with-output-to-string (*standard-output*)
+				  (disassemble test-fun-good-2))))))
+
+(define-test log10-single-transform
+  "Test tranform of (log x 10) to (kernel::log2 x)"
+  (let ((test-fun-good
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (single-float (0f0)) x))
+		     (log x 10)))))
+    ;; test-fun should have transformed (log x 2) to kernel:%log10
+    (assert-true (search "log10" (with-output-to-string (*standard-output*)
+				  (disassemble test-fun-good)))))
+  (let ((test-fun-bad
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (single-float 0f0) x))
+		     (log x 10)))))
+    ;; test-fun should not have transformed (log x 2) to kernel:%log10
+    ;; because x can be -0 for which log should return a complex
+    ;; result.
+    (assert-false (search "log10" (with-output-to-string (*standard-output*)
+				   (disassemble test-fun-bad)))))
+  (let ((test-fun-bad-2
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (single-float (0f0)) x))
+		     (log x 10d0)))))
+    ;; test-fun should not have transformed (log x 2) to kernel:%log10
+    ;; because the result should be a double due to floating-point
+    ;; contagion.
+    (assert-false (search "log10" (with-output-to-string (*standard-output*)
+				   (disassemble test-fun-bad-2))))))
+
+(define-test log10-double-transform
+  "Test tranform of (log x 10) to (kernel:%log10 x)"
+  (let ((test-fun-good
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (double-float (0d0)) x))
+		     (log x 10)))))
+    ;; test-fun should have transformed (log x 10) to kernel:%log10
+    (assert-true (search "log10" (with-output-to-string (*standard-output*)
+				  (disassemble test-fun-good)))))
+  (let ((test-fun-bad
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (double-float 0d0) x))
+		     (log x 10)))))
+    ;; test-fun should not have transformed (log x 10) to kernel:%log10
+    ;; because x can be -0 for which log should return a complex
+    ;; result.
+    (assert-false (search "log10" (with-output-to-string (*standard-output*)
+				   (disassemble test-fun-bad)))))
+  (let ((test-fun-good-2
+	  (compile nil
+		   (lambda (x)
+		     (declare (type (double-float (0d0)) x))
+		     (log x 10f0)))))
+    ;; test-fun should have transformed (log x 10) to kernel:%log10
+    (assert-true (search "log10" (with-output-to-string (*standard-output*)
+				   (disassemble test-fun-good-2))))))

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

Summary of changes:
 src/compiler/float-tran.lisp |   27 +++++++++
 tests/float-tran.lisp        |  129 ++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 152 insertions(+), 4 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp



More information about the cmucl-cvs mailing list