-(dolist (stuff '((* x (%negate x))
- (/ x (%negate x))
- (expt x (/ 1 x))))
- (destructuring-bind (name result minus-result) stuff
- (deftransform name ((x y) '(t (constant-argument real)) '* :eval-name t
- :when :both)
- "fold identity operations"
- (let ((val (continuation-value y)))
- (unless (and (= (abs val) 1)
- (not-more-contagious y x))
- (give-up-ir1-transform))
- (if (minusp val) minus-result result)))))
+(macrolet ((def-frob (name result minus-result)
+ `(deftransform ,name ((x y) (t (constant-arg real))
+ * :when :both)
+ "fold identity operations"
+ (let ((val (continuation-value y)))
+ (unless (and (= (abs val) 1)
+ (not-more-contagious y x))
+ (give-up-ir1-transform))
+ (if (minusp val) ',minus-result ',result)))))
+ (def-frob * x (%negate x))
+ (def-frob / x (%negate x))
+ (def-frob expt x (/ 1 x)))