X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffloat-tran.lisp;h=b0e652a88cfa0363574a6b68c87f1175fa760396;hb=f294da03824843f07d781e655d5a5e70c2c4851e;hp=9ad9f7e4135f7cd0313b6bdb493a1aaf63836ae8;hpb=416152f084604094445a758ff399871132dff2bd;p=sbcl.git diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 9ad9f7e..b0e652a 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -18,23 +18,22 @@ (defknown %single-float (real) single-float (movable foldable flushable)) (defknown %double-float (real) double-float (movable foldable flushable)) -(deftransform float ((n &optional f) (* &optional single-float) * :when :both) +(deftransform float ((n &optional f) (* &optional single-float) *) '(%single-float n)) -(deftransform float ((n f) (* double-float) * :when :both) +(deftransform float ((n f) (* double-float) *) '(%double-float n)) -(deftransform %single-float ((n) (single-float) * :when :both) +(deftransform %single-float ((n) (single-float) *) 'n) -(deftransform %double-float ((n) (double-float) * :when :both) +(deftransform %double-float ((n) (double-float) *) 'n) ;;; RANDOM (macrolet ((frob (fun type) `(deftransform random ((num &optional state) - (,type &optional *) * - :when :both) + (,type &optional *) *) "Use inline float operations." '(,fun num (or state *random-state*))))) (frob %random-single-float single-float) @@ -139,27 +138,26 @@ (defknown scale-double-float (double-float fixnum) double-float (movable foldable flushable)) -(deftransform decode-float ((x) (single-float) * :when :both) +(deftransform decode-float ((x) (single-float) *) '(decode-single-float x)) -(deftransform decode-float ((x) (double-float) * :when :both) +(deftransform decode-float ((x) (double-float) *) '(decode-double-float x)) -(deftransform integer-decode-float ((x) (single-float) * :when :both) +(deftransform integer-decode-float ((x) (single-float) *) '(integer-decode-single-float x)) -(deftransform integer-decode-float ((x) (double-float) * :when :both) +(deftransform integer-decode-float ((x) (double-float) *) '(integer-decode-double-float x)) -(deftransform scale-float ((f ex) (single-float *) * :when :both) +(deftransform scale-float ((f ex) (single-float *) *) (if (and #!+x86 t #!-x86 nil (csubtypep (continuation-type ex) - (specifier-type '(signed-byte 32))) - (not (byte-compiling))) + (specifier-type '(signed-byte 32)))) '(coerce (%scalbn (coerce f 'double-float) ex) 'single-float) '(scale-single-float f ex))) -(deftransform scale-float ((f ex) (double-float *) * :when :both) +(deftransform scale-float ((f ex) (double-float *) *) (if (and #!+x86 t #!-x86 nil (csubtypep (continuation-type ex) (specifier-type '(signed-byte 32)))) @@ -251,11 +249,11 @@ (defun ,aux-name (num) ;; When converting a number to a float, the limits are ;; the same. - (let* ((lo (bound-func #'(lambda (x) - (coerce x ',type)) + (let* ((lo (bound-func (lambda (x) + (coerce x ',type)) (numeric-type-low num))) - (hi (bound-func #'(lambda (x) - (coerce x ',type)) + (hi (bound-func (lambda (x) + (coerce x ',type)) (numeric-type-high num)))) (specifier-type `(,',type ,(or lo '*) ,(or hi '*))))) @@ -271,10 +269,10 @@ ;;; rational arithmetic, or different float types, and fix it up. If ;;; we don't, he won't even get so much as an efficiency note. (deftransform float-contagion-arg1 ((x y) * * :defun-only t :node node) - `(,(continuation-function-name (basic-combination-fun node)) + `(,(continuation-fun-name (basic-combination-fun node)) (float x y) y)) (deftransform float-contagion-arg2 ((x y) * * :defun-only t :node node) - `(,(continuation-function-name (basic-combination-fun node)) + `(,(continuation-fun-name (basic-combination-fun node)) x (float y x))) (dolist (x '(+ * / -)) @@ -293,7 +291,7 @@ ;;; do it for any rational that has a precise representation as a ;;; float (such as 0). (macrolet ((frob (op) - `(deftransform ,op ((x y) (float rational) * :when :both) + `(deftransform ,op ((x y) (float rational) *) "open-code FLOAT to RATIONAL comparison" (unless (constant-continuation-p y) (give-up-ir1-transform @@ -320,7 +318,7 @@ (sqrt (real 0.0)))) (destructuring-bind (name type) stuff (let ((type (specifier-type type))) - (setf (function-info-derive-type (function-info-or-lose name)) + (setf (fun-info-derive-type (fun-info-or-lose name)) (lambda (call) (declare (type combination call)) (when (csubtypep (continuation-type @@ -348,11 +346,13 @@ (movable foldable flushable)) (defknown (%asin %atan) - (double-float) (double-float #.(- (/ pi 2)) #.(/ pi 2)) + (double-float) + (double-float #.(coerce (- (/ pi 2)) 'double-float) + #.(coerce (/ pi 2) 'double-float)) (movable foldable flushable)) (defknown (%acos) - (double-float) (double-float 0.0d0 #.pi) + (double-float) (double-float 0.0d0 #.(coerce pi 'double-float)) (movable foldable flushable)) (defknown (%cosh) @@ -376,7 +376,9 @@ (movable foldable flushable)) (defknown (%atan2) - (double-float double-float) (double-float #.(- pi) #.pi) + (double-float double-float) + (double-float #.(coerce (- pi) 'double-float) + #.(coerce pi 'double-float)) (movable foldable flushable)) (defknown (%scalb) @@ -391,75 +393,77 @@ (double-float) double-float (movable foldable flushable)) -(dolist (stuff '((exp %exp *) - (log %log float) - (sqrt %sqrt float) - (asin %asin float) - (acos %acos float) - (atan %atan *) - (sinh %sinh *) - (cosh %cosh *) - (tanh %tanh *) - (asinh %asinh *) - (acosh %acosh float) - (atanh %atanh float))) - (destructuring-bind (name prim rtype) stuff - (deftransform name ((x) '(single-float) rtype :eval-name t) - `(coerce (,prim (coerce x 'double-float)) 'single-float)) - (deftransform name ((x) '(double-float) rtype :eval-name t :when :both) - `(,prim x)))) +(macrolet ((def (name prim rtype) + `(progn + (deftransform ,name ((x) (single-float) ,rtype) + `(coerce (,',prim (coerce x 'double-float)) 'single-float)) + (deftransform ,name ((x) (double-float) ,rtype) + `(,',prim x))))) + (def exp %exp *) + (def log %log float) + (def sqrt %sqrt float) + (def asin %asin float) + (def acos %acos float) + (def atan %atan *) + (def sinh %sinh *) + (def cosh %cosh *) + (def tanh %tanh *) + (def asinh %asinh *) + (def acosh %acosh float) + (def atanh %atanh float)) ;;; The argument range is limited on the x86 FP trig. functions. A ;;; post-test can detect a failure (and load a suitable result), but ;;; this test is avoided if possible. -(dolist (stuff '((sin %sin %sin-quick) - (cos %cos %cos-quick) - (tan %tan %tan-quick))) - (destructuring-bind (name prim prim-quick) stuff - (declare (ignorable prim-quick)) - (deftransform name ((x) '(single-float) '* :eval-name t) - #!+x86 (cond ((csubtypep (continuation-type x) - (specifier-type '(single-float - (#.(- (expt 2f0 64))) - (#.(expt 2f0 64))))) - `(coerce (,prim-quick (coerce x 'double-float)) - 'single-float)) - (t - (compiler-note - "unable to avoid inline argument range check~@ - because the argument range (~S) was not within 2^64" - (type-specifier (continuation-type x))) - `(coerce (,prim (coerce x 'double-float)) 'single-float))) - #!-x86 `(coerce (,prim (coerce x 'double-float)) 'single-float)) - (deftransform name ((x) '(double-float) '* :eval-name t :when :both) - #!+x86 (cond ((csubtypep (continuation-type x) - (specifier-type '(double-float - (#.(- (expt 2d0 64))) - (#.(expt 2d0 64))))) - `(,prim-quick x)) - (t - (compiler-note - "unable to avoid inline argument range check~@ - because the argument range (~S) was not within 2^64" - (type-specifier (continuation-type x))) - `(,prim x))) - #!-x86 `(,prim x)))) +(macrolet ((def (name prim prim-quick) + (declare (ignorable prim-quick)) + `(progn + (deftransform ,name ((x) (single-float) *) + #!+x86 (cond ((csubtypep (continuation-type x) + (specifier-type '(single-float + (#.(- (expt 2f0 64))) + (#.(expt 2f0 64))))) + `(coerce (,',prim-quick (coerce x 'double-float)) + 'single-float)) + (t + (compiler-note + "unable to avoid inline argument range check~@ + because the argument range (~S) was not within 2^64" + (type-specifier (continuation-type x))) + `(coerce (,',prim (coerce x 'double-float)) 'single-float))) + #!-x86 `(coerce (,',prim (coerce x 'double-float)) 'single-float)) + (deftransform ,name ((x) (double-float) *) + #!+x86 (cond ((csubtypep (continuation-type x) + (specifier-type '(double-float + (#.(- (expt 2d0 64))) + (#.(expt 2d0 64))))) + `(,',prim-quick x)) + (t + (compiler-note + "unable to avoid inline argument range check~@ + because the argument range (~S) was not within 2^64" + (type-specifier (continuation-type x))) + `(,',prim x))) + #!-x86 `(,',prim x))))) + (def sin %sin %sin-quick) + (def cos %cos %cos-quick) + (def tan %tan %tan-quick)) (deftransform atan ((x y) (single-float single-float) *) `(coerce (%atan2 (coerce x 'double-float) (coerce y 'double-float)) 'single-float)) -(deftransform atan ((x y) (double-float double-float) * :when :both) +(deftransform atan ((x y) (double-float double-float) *) `(%atan2 x y)) (deftransform expt ((x y) ((single-float 0f0) single-float) *) `(coerce (%pow (coerce x 'double-float) (coerce y 'double-float)) 'single-float)) -(deftransform expt ((x y) ((double-float 0d0) double-float) * :when :both) +(deftransform expt ((x y) ((double-float 0d0) double-float) *) `(%pow x y)) (deftransform expt ((x y) ((single-float 0f0) (signed-byte 32)) *) `(coerce (%pow (coerce x 'double-float) (coerce y 'double-float)) 'single-float)) -(deftransform expt ((x y) ((double-float 0d0) (signed-byte 32)) * :when :both) +(deftransform expt ((x y) ((double-float 0d0) (signed-byte 32)) *) `(%pow x (coerce y 'double-float))) ;;; ANSI says log with base zero returns zero. @@ -468,7 +472,7 @@ ;;; Handle some simple transformations. -(deftransform abs ((x) ((complex double-float)) double-float :when :both) +(deftransform abs ((x) ((complex double-float)) double-float) '(%hypot (realpart x) (imagpart x))) (deftransform abs ((x) ((complex single-float)) single-float) @@ -476,7 +480,7 @@ (coerce (imagpart x) 'double-float)) 'single-float)) -(deftransform phase ((x) ((complex double-float)) double-float :when :both) +(deftransform phase ((x) ((complex double-float)) double-float) '(%atan2 (imagpart x) (realpart x))) (deftransform phase ((x) ((complex single-float)) single-float) @@ -484,7 +488,7 @@ (coerce (realpart x) 'double-float)) 'single-float)) -(deftransform phase ((x) ((float)) float :when :both) +(deftransform phase ((x) ((float)) float) '(if (minusp (float-sign x)) (float pi x) (float 0 x))) @@ -648,11 +652,11 @@ `(defoptimizer (,name derive-type) ((,num)) (one-arg-derive-type ,num - #'(lambda (arg) - (elfun-derive-type-simple arg #',name - ,domain-low ,domain-high - ,def-low-bnd ,def-high-bnd - ,increasingp)) + (lambda (arg) + (elfun-derive-type-simple arg #',name + ,domain-low ,domain-high + ,def-low-bnd ,def-high-bnd + ,increasingp)) #',name))))) ;; These functions are easy because they are defined for the whole ;; real line. @@ -1270,9 +1274,9 @@ (defoptimizer (cis derive-type) ((num)) (one-arg-derive-type num - #'(lambda (arg) - (sb!c::specifier-type - `(complex ,(or (numeric-type-format arg) 'float)))) + (lambda (arg) + (sb!c::specifier-type + `(complex ,(or (numeric-type-format arg) 'float)))) #'cis)) ) ; PROGN @@ -1284,7 +1288,7 @@ (defknown ,ufun (real) integer (movable foldable flushable)) (deftransform ,fun ((x &optional by) (* &optional - (constant-argument (member 1)))) + (constant-arg (member 1)))) '(let ((res (,ufun x))) (values res (- x res))))))) (define-frobs truncate %unary-truncate)