(deftransform scale-float ((f ex) (single-float *) * :when :both)
(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)))
(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 some stuff to recognize when the loser is doing mixed float and
;;; rational arithmetic, or different float types, and fix it up. If
-;;; we don't, he won't even get so much as an efficency note.
+;;; 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 '(+ * / -))
(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
(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 :when :both)
+ `(,',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) * :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)))))
+ (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))
`(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