- (compound-type
- (reduce #'+ (compound-type-types type) :key 'type-test-cost))
- (member-type
- (* (length (member-type-members type))
- (fun-guessed-cost 'eq)))
- (numeric-type
- (* (if (numeric-type-complexp type) 2 1)
- (fun-guessed-cost
- (if (csubtypep type (specifier-type 'fixnum)) 'fixnump 'numberp))
- (+ 1
- (if (numeric-type-low type) 1 0)
- (if (numeric-type-high type) 1 0))))
- (cons-type
- (+ (type-test-cost (specifier-type 'cons))
- (fun-guessed-cost 'car)
- (type-test-cost (cons-type-car-type type))
- (fun-guessed-cost 'cdr)
- (type-test-cost (cons-type-cdr-type type))))
- (t
- (fun-guessed-cost 'typep)))))
+ (compound-type
+ (reduce #'+ (compound-type-types type) :key 'type-test-cost))
+ (member-type
+ (* (member-type-size type)
+ (fun-guessed-cost 'eq)))
+ (numeric-type
+ (* (if (numeric-type-complexp type) 2 1)
+ (fun-guessed-cost
+ (if (csubtypep type (specifier-type 'fixnum)) 'fixnump 'numberp))
+ (+ 1
+ (if (numeric-type-low type) 1 0)
+ (if (numeric-type-high type) 1 0))))
+ (cons-type
+ (+ (type-test-cost (specifier-type 'cons))
+ (fun-guessed-cost 'car)
+ (type-test-cost (cons-type-car-type type))
+ (fun-guessed-cost 'cdr)
+ (type-test-cost (cons-type-cdr-type type))))
+ (t
+ (fun-guessed-cost 'typep)))))
+
+(defun weaken-integer-type (type)
+ (cond ((union-type-p type)
+ (let* ((types (union-type-types type))
+ (one (pop types))
+ (low (numeric-type-low one))
+ (high (numeric-type-high one)))
+ (flet ((maximize (bound)
+ (if (and bound high)
+ (setf high (max high bound))
+ (setf high nil)))
+ (minimize (bound)
+ (if (and bound low)
+ (setf low (min low bound))
+ (setf low nil))))
+ (dolist (a types)
+ (minimize (numeric-type-low a))
+ (maximize (numeric-type-high a))))
+ (specifier-type `(integer ,(or low '*) ,(or high '*)))))
+ (t
+ (aver (integer-type-p type))
+ type)))