diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 25d4dffddaefe9ebfc6ba3f11f59f86d90d4676e..f490df482fe209ef947da62953e460af1764d3e3 100644 --- a/compiler/float-tran.lisp +++ b/compiler/float-tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.41 1997/11/16 14:05:23 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.42 1997/11/27 02:50:16 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1054,35 +1054,45 @@ #+complex-float (progn -;;; Make REALPART and IMAGPART return the appropriate types. This -;;; helps a lot in optimized code. (deftransform realpart ((x) ((complex rational)) *) '(kernel:%realpart x)) (deftransform imagpart ((x) ((complex rational)) *) '(kernel:%imagpart x)) +) ;end progn complex-float +;;; Make REALPART and IMAGPART return the appropriate types. This +;;; should help a lot in optimized code. (defoptimizer (realpart derive-type) ((num)) - (let ((type (continuation-type num))) + (flet ((realpart-derive (type) (cond ((numeric-type-real-p type) - ;; The realpart of a real has the same type and range as the input. + ;; The realpart of a real has the same type and + ;; range as the input. (make-numeric-type :class (numeric-type-class type) :format (numeric-type-format type) :complexp :real :low (numeric-type-low type) :high (numeric-type-high type))) (t - ;; We have a complex number. The result has the same type - ;; as the real part, except that it's real, not complex, - ;; obviously. + ;; We have a complex number. The result has the + ;; same type as the real part, except that it's + ;; real, not complex, obviously. (make-numeric-type :class (numeric-type-class type) :format (numeric-type-format type) :complexp :real :low (numeric-type-low type) :high (numeric-type-high type)))))) + (let ((type (continuation-type num))) + (cond ((union-type-p type) + (let ((result '())) + (dolist (x (union-type-types type)) + (push (realpart-derive x) result)) + (make-union-type result))) + (t + (realpart-derive type)))))) (defoptimizer (imagpart derive-type) ((num)) - (let ((type (continuation-type num))) + (flet ((imagpart-derive (type) (cond ((numeric-type-real-p type) ;; The imagpart of a real has the same type as the input, ;; except that it's zero @@ -1100,9 +1110,119 @@ :complexp :real :low (numeric-type-low type) :high (numeric-type-high type)))))) - + (let ((type (continuation-type num))) + (cond ((union-type-p type) + (let ((result '())) + (dolist (x (union-type-types type)) + (push (imagpart-derive x) result)) + (make-union-type result))) + (t + (imagpart-derive type)))))) + +(defoptimizer (complex derive-type) ((re im)) + (let* ((re-type (continuation-type re)) + (im-type (continuation-type im)) + (element-type (numeric-contagion re-type im-type))) + ;; Need to check to make sure numeric-contagion returns the right + ;; type for what we want here. + (make-numeric-type :class (numeric-type-class element-type) + :format (numeric-type-format element-type) + :complexp :complex))) + +(macrolet ((frob (op type) + `(progn + (deftransform ,op ((w z) ((complex ,type) (complex ,type)) + (complex ,type)) + '(complex (,op (realpart w) (realpart z)) + (,op (imagpart w) (imagpart z))))))) + ;; Complex addition and subtraction + (frob + single-float) + (frob + double-float) + (frob - single-float) + (frob - double-float)) + +(macrolet ((frob (type) + `(progn + (deftransform + ((w z) ((complex ,type) ,type) + (complex ,type)) + '(complex (+ (realpart w) z) + (imagpart w))) + (deftransform + ((z w) (,type (complex ,type)) + (complex ,type)) + '(complex (+ (realpart w) z) + (imagpart w)))))) + + ;; Add and sub between a complex number and a float. + (frob single-float) + (frob double-float)) + +(macrolet ((frob (type) + `(progn + (deftransform - ((w z) ((complex ,type) ,type) + (complex ,type)) + '(complex (- (realpart w) z) + (imagpart w))) + (deftransform - ((z w) (,type (complex ,type)) + (complex ,type)) + '(complex (- z (realpart w)) + (- (imagpart w))))))) + + ;; Add and sub between a complex number and a float. + (frob single-float) + (frob double-float)) + +(macrolet ((frob (type) + `(progn + (deftransform * ((x y) ((complex ,type) (complex ,type)) + (complex ,type)) + '(let* ((rx (realpart x)) + (ix (imagpart x)) + (ry (realpart y)) + (iy (imagpart y))) + (complex (- (* rx ry) (* ix iy)) + (+ (* rx iy) (* ix ry))))) + (deftransform / ((x y) ((complex ,type) (complex ,type)) + (complex ,type)) + '(let* ((rx (realpart x)) + (ix (imagpart x)) + (ry (realpart y)) + (iy (imagpart y))) + (if (> (abs ry) (abs iy)) + (let* ((r (/ iy ry)) + (dn (* ry (+ 1 (* r r))))) + (complex (/ (+ rx (* ix r)) dn) + (/ (- ix (* rx r)) dn))) + (let* ((r (/ ry iy)) + (dn (* iy (+ 1 (* r r))))) + (complex (/ (+ (* rx r) ix) dn) + (/ (- (* ix r) rx) dn)))))) + ))) + ;; Multiplication and division for complex numbers + (frob single-float) + (frob double-float)) + +(macrolet ((frob (type) + `(progn + (deftransform * ((w z) ((complex ,type) ,type) + (complex ,type)) + '(complex (* (realpart w) z) + (* (imagpart w) z))) + (deftransform * ((z w) (,type (complex ,type)) + (complex ,type)) + '(complex (* (realpart w) z) + (* (imagpart w) z)))))) + (frob single-float) + (frob double-float)) + +(macrolet ((frob (type) + `(progn + (deftransform / ((w z) ((complex ,type) ,type) + (complex ,type)) + '(complex (/ (realpart w) z) + (/ (imagpart w) z)))))) -) ;end progn complex-float + (frob single-float) + (frob double-float)) ;;; Here are simple optimizers for sin, cos, and tan. They do not