conditionals.
* optimization: bitwise OR forms can now trigger modular arithmetic as well,
when the result is known to be negative.
+ * optimization: recognize more cases of useless LOGAND/LOGIOR with constants.
* bug fix: problems with NCONC type derivation (reported by Jerry James).
* bug fix: EXPT type derivation no longer constructs bogus floating-point
types. (reported by Vsevolod Dyomkin)
(def logxor -1 (lognot x))
(def logxor 0 x))
+(defun least-zero-bit (x)
+ (and (/= x -1)
+ (1- (integer-length (logxor x (1+ x))))))
+
(deftransform logand ((x y) (* (constant-arg t)) *)
"fold identity operation"
- (let ((y (lvar-value y)))
- (unless (and (plusp y)
- (= y (1- (ash 1 (integer-length y)))))
- (give-up-ir1-transform))
- (unless (csubtypep (lvar-type x)
- (specifier-type `(integer 0 ,y)))
+ (let* ((y (lvar-value y))
+ (width (or (least-zero-bit y) '*)))
+ (unless (and (neq width 0) ; (logand x 0) handled elsewhere
+ (csubtypep (lvar-type x)
+ (specifier-type `(unsigned-byte ,width))))
(give-up-ir1-transform))
'x))
(give-up-ir1-transform))
'x))
+(deftransform logior ((x y) (* (constant-arg t)) *)
+ "fold identity operation"
+ (let* ((y (lvar-value y))
+ (width (or (least-zero-bit (lognot y))
+ (give-up-ir1-transform)))) ; (logior x 0) handled elsewhere
+ (unless (csubtypep (lvar-type x)
+ (specifier-type `(integer ,(- (ash 1 width)) -1)))
+ (give-up-ir1-transform))
+ 'x))
+
;;; Pick off easy association opportunities for constant folding.
;;; More complicated stuff that also depends on commutativity
;;; (e.g. (f (f x k1) (f y k2)) => (f (f x y) (f k1 k2))) should
(the (integer 21371810342718833225 21371810343571293860) b))))
16779072918521075607 21371810342718833263)
2923729245085762055)))
+
+(with-test (:name :complicated-logand-identity)
+ (loop for k from -8 upto 8 do
+ (loop for min from -16 upto 16 do
+ (loop for max from min upto 16 do
+ (let ((f (compile nil `(lambda (x)
+ (declare (type (integer ,min ,max) x))
+ (logand x ,k)))))
+ (loop for x from min upto max do
+ (assert (eql (logand x k) (funcall f x)))))))))
+
+(with-test (:name :complicated-logior-identity)
+ (loop for k from -8 upto 8 do
+ (loop for min from -16 upto 16 do
+ (loop for max from min upto 16 do
+ (let ((f (compile nil `(lambda (x)
+ (declare (type (integer ,min ,max) x))
+ (logior x ,k)))))
+ (loop for x from min upto max do
+ (assert (eql (logior x k) (funcall f x)))))))))