[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-01-16-g93656b6

[Raymond Toy]

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  93656b6aa0ef4e939a84dfb62a6f088f58d3ff62 (commit)
      from  ab191d0f0c6c3744688042d14f754c3e35a4a793 (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 93656b6aa0ef4e939a84dfb62a6f088f58d3ff62
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Wed Jan 23 21:22:24 2013 -0800

    Fix ticket:65.  Implement the deftransform in the expt function.

diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index e295fe2..f04b154 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -488,7 +488,22 @@
 				  (declare (double-float y*pi))
 				  (complex
 				   (coerce (* pow (%cos y*pi)) rtype)
-				   (coerce (* pow (%sin y*pi)) rtype)))))))))))))
+				   (coerce (* pow (%sin y*pi)) rtype))))))))))))
+	     (expt-xfrm (b p)
+	       ;; Apply the same transformation as in the deftransform
+	       ;; for expt in compiler/srctran.lisp.  Only call this
+	       ;; if B is more contagious than P.  Otherwise, the type
+	       ;; of the result will be wrong which will confuse the
+	       ;; compiler!  Return NIL if the transform can't be
+	       ;; applied.
+	       (cond
+		 ((= p 2) (* b b))
+		 ((= p -2) (/ (* b b)))
+		 ((= p 3) (* b b b))
+		 ((= p -3) (/ (* b b b)))
+		 ((= p 1/2) (sqrt b))
+		 ((= p -1/2) (/ (sqrt b)))
+		 (t nil))))
       ;; This is really messy and should be cleaned up.  The easiest
       ;; way to see if we're doing what we should is the macroexpand
       ;; the number-dispatch and check each branch.
@@ -523,8 +538,9 @@
 	(((foreach (complex rational) (complex single-float) (complex double-float)
 		   #+double-double (complex double-double-float))
 	  rational)
-	 (* (expt (abs base) power)
-	    (cis (* power (phase base)))))
+	 (or (expt-xfrm base power)
+	     (* (expt (abs base) power)
+		(cis (* power (phase base))))))
 	#+double-double
 	((double-double-float
 	  complex)
@@ -560,36 +576,45 @@
 	  (foreach single-float (complex single-float)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
-	     (exp (* power (log base)))))
+	     (or (expt-xfrm (coerce base '(complex single-float)) power)
+		 (exp (* power (log base))))))
 	(((foreach (complex rational) (complex single-float))
 	  (foreach double-float (complex double-float)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
-	     (exp (* power (log (coerce base '(complex double-float)))))))
+	     (or (expt-xfrm (coerce base '(complex double-float))
+			    power)
+		 (exp (* power (log (coerce base '(complex double-float))))))))
 	#+double-double
 	(((foreach (complex rational) (complex single-float))
 	  (foreach double-double-float (complex double-double-float)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
-	     (exp (* power (log (coerce base '(complex double-double-float)))))))
+	     (or (expt-xfrm (coerce base '(complex double-double-float))
+			    power)
+		 (exp (* power (log (coerce base '(complex double-double-float))))))))
 	(((foreach (complex double-float))
-	  (foreach single-float double-float (complex single-float)
-		   (complex double-float)))
+	  (foreach single-float double-float
+		   (complex single-float) (complex double-float)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
-	     (exp (* power (log base)))))
+	     (or (expt-xfrm base power)
+		 (exp (* power (log base))))))
 	#+double-double
 	(((foreach (complex double-float))
 	  (foreach double-double-float (complex double-double-float)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
-	     (exp (* power (log (coerce base '(complex double-double-float)))))))
+	     (or (expt-xfrm (coerce base '(complex double-double-float))
+			    power)
+		 (exp (* power (log (coerce base '(complex double-double-float))))))))
 	#+double-double
 	(((foreach (complex double-double-float))
 	  (foreach float (complex float)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
-	     (exp (* power (log base)))))))))
+	     (or (expt-xfrm base power)
+		 (exp (* power (log base))))))))))
 
 ;; Log base 2 of a real number.  The result is a either a double-float
 ;; or double-double-float number (real or complex, as appropriate),

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

Summary of changes:
 src/code/irrat.lisp |   47 ++++++++++++++++++++++++++++++++++++-----------
 1 files changed, 36 insertions(+), 11 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp