- (let ((inside-args (combination-args value-node)))
- (unless (= (length inside-args) 2)
- (give-up-ir1-transform))
- (let ((inside-amount (second inside-args)))
- (unless (and (constant-continuation-p inside-amount)
- (not (minusp (continuation-value inside-amount))))
- (give-up-ir1-transform)))))
- (extract-fun-args value 'ash 2)
- '(lambda (value amount1 amount2)
- (ash value (+ amount1 amount2))))
+ (let ((inside-fun-name (lvar-fun-name (combination-fun value-node))))
+ (multiple-value-bind (prototype width)
+ (modular-version-info inside-fun-name)
+ (unless (eq (or prototype inside-fun-name) 'ash)
+ (give-up-ir1-transform))
+ (when (and width (not (constant-lvar-p amount)))
+ (give-up-ir1-transform))
+ (let ((inside-args (combination-args value-node)))
+ (unless (= (length inside-args) 2)
+ (give-up-ir1-transform))
+ (let ((inside-amount (second inside-args)))
+ (unless (and (constant-lvar-p inside-amount)
+ (not (minusp (lvar-value inside-amount))))
+ (give-up-ir1-transform)))
+ (extract-fun-args value inside-fun-name 2)
+ (if width
+ `(lambda (value amount1 amount2)
+ (logand (ash value (+ amount1 amount2))
+ ,(1- (ash 1 (+ width (lvar-value amount))))))
+ `(lambda (value amount1 amount2)
+ (ash value (+ amount1 amount2)))))))))