(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)
(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))))
'(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))))
(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 '*)))))
;;; 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
(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
(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)
(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)
(double-float) double-float
(movable foldable flushable))
-(macrolet ((def-frob (name prim rtype)
+(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 :when :both)
+ (deftransform ,name ((x) (double-float) ,rtype)
`(,',prim x)))))
- (def-frob exp %exp *)
- (def-frob log %log float)
- (def-frob sqrt %sqrt float)
- (def-frob asin %asin float)
- (def-frob acos %acos float)
- (def-frob atan %atan *)
- (def-frob sinh %sinh *)
- (def-frob cosh %cosh *)
- (def-frob tanh %tanh *)
- (def-frob asinh %asinh *)
- (def-frob acosh %acosh float)
- (def-frob atanh %atanh float))
+ (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.
-(macrolet ((def-frob (name prim prim-quick)
+(macrolet ((def (name prim prim-quick)
(declare (ignorable prim-quick))
`(progn
(deftransform ,name ((x) (single-float) *)
(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) * :when :both)
+ (deftransform ,name ((x) (double-float) *)
#!+x86 (cond ((csubtypep (continuation-type x)
(specifier-type '(double-float
(#.(- (expt 2d0 64)))
(type-specifier (continuation-type x)))
`(,',prim x)))
#!-x86 `(,',prim x)))))
- (def-frob sin %sin %sin-quick)
- (def-frob cos %cos %cos-quick)
- (def-frob tan %tan %tan-quick))
+ (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.
\f
;;; 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)
(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)
(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)))
`(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.
(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
(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)
projects / sbcl.git / blobdiff