-(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 (lvar-type x)
+ (specifier-type '(single-float
+ (#.(- (expt 2f0 64)))
+ (#.(expt 2f0 64)))))
+ `(coerce (,',prim-quick (coerce x 'double-float))
+ 'single-float))
+ (t
+ (compiler-notify
+ "unable to avoid inline argument range check~@
+ because the argument range (~S) was not within 2^64"
+ (type-specifier (lvar-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 (lvar-type x)
+ (specifier-type '(double-float
+ (#.(- (expt 2d0 64)))
+ (#.(expt 2d0 64)))))
+ `(,',prim-quick x))
+ (t
+ (compiler-notify
+ "unable to avoid inline argument range check~@
+ because the argument range (~S) was not within 2^64"
+ (type-specifier (lvar-type x)))
+ `(,',prim x)))
+ #!-x86 `(,',prim x)))))
+ (def sin %sin %sin-quick)
+ (def cos %cos %cos-quick)
+ (def tan %tan %tan-quick))