From db25e3e006f90d031ecca30aa1b04e77fc1be619 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Sat, 20 Sep 2014 17:59:16 -0700
Subject: [PATCH] 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.
---
 src/compiler/float-tran.lisp |  27 ++++++++
 tests/float-tran.lisp        | 129 +++++++++++++++++++++++++++++++++--
 2 files changed, 152 insertions(+), 4 deletions(-)

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 4aecd5cd2..f4744299f 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 9c818824b..0c47dce47 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))))))
-- 
GitLab