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