[git] CMU Common Lisp branch master updated. snapshot20140913gdb25e3e
Raymond Toy
rtoy at commonlisp.net
Sun Sep 21 00:59:27 UTC 2014
This is an automated email from the git hooks/postreceive 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/floattran.lisp:
* Add deftransforms to convert (log x 2) and (log x 10) to
kernel::log2 and kernel:%log10
* tests/floattran.lisp:
* Add tests to check the transforms are done, or not done, as
appropriate.
diff git a/src/compiler/floattran.lisp b/src/compiler/floattran.lisp
index 4aecd5c..f474429 100644
 a/src/compiler/floattran.lisp
+++ b/src/compiler/floattran.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) (singlefloat (0f0)))
+ (constantargument number))
+ singlefloat)
+ ;; Transform (log x 2) and (log x 10) to something simpler.
+ (let ((yval (continuationvalue y)))
+ (unless (and (notmorecontagious y x)
+ (or (= yval 2)
+ (= yval 10)))
+ (giveup))
+ (cond ((= yval 10)
+ `(coerce (kernel:%log10 (float x 1d0)) 'singlefloat))
+ ((= yval 2)
+ `(coerce (kernel::log2 (float x 1d0)) 'singlefloat)))))
+
+(deftransform log ((x y) ((or (member 0d0) (doublefloat 0d0))
+ (constantargument number))
+ doublefloat)
+ ;; Transform (log x 2) and (log x 10) to something simpler.
+ (let ((yval (continuationvalue y)))
+ (unless (and (notmorecontagious y x)
+ (or (= yval 2)
+ (= yval 10)))
+ (giveup))
+ (cond ((= yval 10)
+ `(kernel:%log10 (float x 1d0)))
+ ((= yval 2)
+ `(kernel::log2 (float x 1d0))))))
;;; Handle some simple transformations
diff git a/tests/floattran.lisp b/tests/floattran.lisp
index 9c81882..0c47dce 100644
 a/tests/floattran.lisp
+++ b/tests/floattran.lisp
@@ 8,10 +8,131 @@
(definetest decodefloatsign
"Test type derivation of the sign from decodefloat"
(assertequalp (c::makemembertype :members (list 1f0 1f0))
 (c::decodefloatsignderivetypeaux (c::specifiertype 'singlefloat)))
+ (c::decodefloatsignderivetypeaux
+ (c::specifiertype 'singlefloat)))
(assertequalp (c::makemembertype :members (list 1d0 1d0))
 (c::decodefloatsignderivetypeaux (c::specifiertype 'doublefloat)))
+ (c::decodefloatsignderivetypeaux
+ (c::specifiertype 'doublefloat)))
(assertequalp (c::makemembertype :members (list 1f0))
 (c::decodefloatsignderivetypeaux (c::specifiertype '(singlefloat (0f0))))))
+ (c::decodefloatsignderivetypeaux
+ (c::specifiertype '(singlefloat (0f0))))))

\ No newline at end of file
+(definetest log2singletransform
+ "Test tranform of (log x 2) to (kernel::log2 x)"
+ (let ((testfun
+ (compile nil
+ (lambda (x)
+ (declare (type (singlefloat (0f0)) x))
+ (log x 2)))))
+ ;; testfun should have transformed (log x 2) to kernel::log2
+ (asserttrue (search "log2" (withoutputtostring (*standardoutput*)
+ (disassemble testfun)))))
+ (let ((testfun
+ (compile nil
+ (lambda (x)
+ (declare (type (singlefloat 0f0) x))
+ (log x 2)))))
+ ;; testfun should not have transformed (log x 2) to kernel::log2
+ ;; because x can be 0 for which log should return a complex
+ ;; result.
+ (assertfalse (search "log2" (withoutputtostring (*standardoutput*)
+ (disassemble testfun)))))
+ (let ((testfun
+ (compile nil
+ (lambda (x)
+ (declare (type (singlefloat 0f0) x))
+ (log x 2d0)))))
+ ;; testfun should not have transformed (log x 2) to kernel::log2
+ ;; because the result should be a double due to floatingpoint
+ ;; contagion.
+ (assertfalse (search "log2" (withoutputtostring (*standardoutput*)
+ (disassemble testfun))))))
+
+(definetest log2doubletransform
+ "Test tranform of (log x 2) to (kernel::log2 x)"
+ (let ((testfungood
+ (compile nil
+ (lambda (x)
+ (declare (type (doublefloat (0d0)) x))
+ (log x 2)))))
+ ;; testfun should have transformed (log x 2) to kernel::log2
+ (asserttrue (search "log2" (withoutputtostring (*standardoutput*)
+ (disassemble testfungood)))))
+ (let ((testfunbad
+ (compile nil
+ (lambda (x)
+ (declare (type (doublefloat 0d0) x))
+ (log x 2)))))
+ ;; testfun should not have transformed (log x 2) to kernel::log2
+ ;; because x can be 0 for which log should return a complex
+ ;; result.
+ (assertfalse (search "log2" (withoutputtostring (*standardoutput*)
+ (disassemble testfunbad)))))
+ (let ((testfungood2
+ (compile nil
+ (lambda (x)
+ (declare (type (doublefloat (0d0)) x))
+ (log x 2f0)))))
+ ;; testfun should have transformed (log x 2) to kernel::log2
+ (asserttrue (search "log2" (withoutputtostring (*standardoutput*)
+ (disassemble testfungood2))))))
+
+(definetest log10singletransform
+ "Test tranform of (log x 10) to (kernel::log2 x)"
+ (let ((testfungood
+ (compile nil
+ (lambda (x)
+ (declare (type (singlefloat (0f0)) x))
+ (log x 10)))))
+ ;; testfun should have transformed (log x 2) to kernel:%log10
+ (asserttrue (search "log10" (withoutputtostring (*standardoutput*)
+ (disassemble testfungood)))))
+ (let ((testfunbad
+ (compile nil
+ (lambda (x)
+ (declare (type (singlefloat 0f0) x))
+ (log x 10)))))
+ ;; testfun should not have transformed (log x 2) to kernel:%log10
+ ;; because x can be 0 for which log should return a complex
+ ;; result.
+ (assertfalse (search "log10" (withoutputtostring (*standardoutput*)
+ (disassemble testfunbad)))))
+ (let ((testfunbad2
+ (compile nil
+ (lambda (x)
+ (declare (type (singlefloat (0f0)) x))
+ (log x 10d0)))))
+ ;; testfun should not have transformed (log x 2) to kernel:%log10
+ ;; because the result should be a double due to floatingpoint
+ ;; contagion.
+ (assertfalse (search "log10" (withoutputtostring (*standardoutput*)
+ (disassemble testfunbad2))))))
+
+(definetest log10doubletransform
+ "Test tranform of (log x 10) to (kernel:%log10 x)"
+ (let ((testfungood
+ (compile nil
+ (lambda (x)
+ (declare (type (doublefloat (0d0)) x))
+ (log x 10)))))
+ ;; testfun should have transformed (log x 10) to kernel:%log10
+ (asserttrue (search "log10" (withoutputtostring (*standardoutput*)
+ (disassemble testfungood)))))
+ (let ((testfunbad
+ (compile nil
+ (lambda (x)
+ (declare (type (doublefloat 0d0) x))
+ (log x 10)))))
+ ;; testfun should not have transformed (log x 10) to kernel:%log10
+ ;; because x can be 0 for which log should return a complex
+ ;; result.
+ (assertfalse (search "log10" (withoutputtostring (*standardoutput*)
+ (disassemble testfunbad)))))
+ (let ((testfungood2
+ (compile nil
+ (lambda (x)
+ (declare (type (doublefloat (0d0)) x))
+ (log x 10f0)))))
+ ;; testfun should have transformed (log x 10) to kernel:%log10
+ (asserttrue (search "log10" (withoutputtostring (*standardoutput*)
+ (disassemble testfungood2))))))

Summary of changes:
src/compiler/floattran.lisp  27 +++++++++
tests/floattran.lisp  129 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 152 insertions(+), 4 deletions()
hooks/postreceive

CMU Common Lisp
More information about the cmuclcvs
mailing list