-#!-sb-propagate-fun-type
-(progn
-
-(defoptimizer (logand derive-type) ((x y))
- (multiple-value-bind (x-len x-pos x-neg)
- (integer-type-length (continuation-type x))
- (declare (ignore x-pos))
- (multiple-value-bind (y-len y-pos y-neg)
- (integer-type-length (continuation-type y))
- (declare (ignore y-pos))
- (if (not x-neg)
- ;; X must be positive.
- (if (not y-neg)
- ;; The must both be positive.
- (cond ((or (null x-len) (null y-len))
- (specifier-type 'unsigned-byte))
- ((or (zerop x-len) (zerop y-len))
- (specifier-type '(integer 0 0)))
- (t
- (specifier-type `(unsigned-byte ,(min x-len y-len)))))
- ;; X is positive, but Y might be negative.
- (cond ((null x-len)
- (specifier-type 'unsigned-byte))
- ((zerop x-len)
- (specifier-type '(integer 0 0)))
- (t
- (specifier-type `(unsigned-byte ,x-len)))))
- ;; X might be negative.
- (if (not y-neg)
- ;; Y must be positive.
- (cond ((null y-len)
- (specifier-type 'unsigned-byte))
- ((zerop y-len)
- (specifier-type '(integer 0 0)))
- (t
- (specifier-type
- `(unsigned-byte ,y-len))))
- ;; Either might be negative.
- (if (and x-len y-len)
- ;; The result is bounded.
- (specifier-type `(signed-byte ,(1+ (max x-len y-len))))
- ;; We can't tell squat about the result.
- (specifier-type 'integer)))))))
-
-(defoptimizer (logior derive-type) ((x y))
- (multiple-value-bind (x-len x-pos x-neg)
- (integer-type-length (continuation-type x))
- (multiple-value-bind (y-len y-pos y-neg)
- (integer-type-length (continuation-type y))
- (cond
- ((and (not x-neg) (not y-neg))
- ;; Both are positive.
- (specifier-type `(unsigned-byte ,(if (and x-len y-len)
- (max x-len y-len)
- '*))))
- ((not x-pos)
- ;; X must be negative.
- (if (not y-pos)
- ;; Both are negative. The result is going to be negative and be
- ;; the same length or shorter than the smaller.
- (if (and x-len y-len)
- ;; It's bounded.
- (specifier-type `(integer ,(ash -1 (min x-len y-len)) -1))
- ;; It's unbounded.
- (specifier-type '(integer * -1)))
- ;; X is negative, but we don't know about Y. The result will be
- ;; negative, but no more negative than X.
- (specifier-type
- `(integer ,(or (numeric-type-low (continuation-type x)) '*)
- -1))))
- (t
- ;; X might be either positive or negative.
- (if (not y-pos)
- ;; But Y is negative. The result will be negative.
- (specifier-type
- `(integer ,(or (numeric-type-low (continuation-type y)) '*)
- -1))
- ;; We don't know squat about either. It won't get any bigger.
- (if (and x-len y-len)
- ;; Bounded.
- (specifier-type `(signed-byte ,(1+ (max x-len y-len))))
- ;; Unbounded.
- (specifier-type 'integer))))))))
-
-(defoptimizer (logxor derive-type) ((x y))
- (multiple-value-bind (x-len x-pos x-neg)
- (integer-type-length (continuation-type x))
- (multiple-value-bind (y-len y-pos y-neg)
- (integer-type-length (continuation-type y))
- (cond
- ((or (and (not x-neg) (not y-neg))
- (and (not x-pos) (not y-pos)))
- ;; Either both are negative or both are positive. The result
- ;; will be positive, and as long as the longer.
- (specifier-type `(unsigned-byte ,(if (and x-len y-len)
- (max x-len y-len)
- '*))))
- ((or (and (not x-pos) (not y-neg))
- (and (not y-neg) (not y-pos)))
- ;; Either X is negative and Y is positive of vice-versa. The
- ;; result will be negative.
- (specifier-type `(integer ,(if (and x-len y-len)
- (ash -1 (max x-len y-len))
- '*)
- -1)))
- ;; We can't tell what the sign of the result is going to be.
- ;; All we know is that we don't create new bits.
- ((and x-len y-len)
- (specifier-type `(signed-byte ,(1+ (max x-len y-len)))))
- (t
- (specifier-type 'integer))))))
-
-) ; PROGN
-
-#!+sb-propagate-fun-type
-(progn
-