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