1
(values-type-max-value-count type)))
+;;; VALUES type with a single value.
(defun type-single-value-p (type)
- (and (values-type-p type)
+ (and (%values-type-p type)
(not (values-type-rest type))
(null (values-type-optional type))
(singleton-p (values-type-required type))))
:high (if (null (numeric-type-high type1))
nil
(list (1+ (numeric-type-high type1)))))))
- (type-union type1
- (apply #'type-intersection
- (remove (specifier-type '(not integer))
- (intersection-type-types type2)
- :test #'type=))))
+ (let* ((intersected (intersection-type-types type2))
+ (remaining (remove (specifier-type '(not integer))
+ intersected
+ :test #'type=)))
+ (and (not (equal intersected remaining))
+ (type-union type1 (apply #'type-intersection remaining)))))
(t
(let ((accumulator *universal-type*))
(do ((t2s (intersection-type-types type2) (cdr t2s)))
((type= type (specifier-type 'base-char)) 'base-char)
((type= type (specifier-type 'extended-char)) 'extended-char)
((type= type (specifier-type 'standard-char)) 'standard-char)
- (t (let ((pairs (character-set-type-pairs type)))
- `(member ,@(loop for (low . high) in pairs
+ (t
+ ;; Unparse into either MEMBER or CHARACTER-SET. We use MEMBER if there
+ ;; are at most as many characters than there are character code ranges.
+ (let* ((pairs (character-set-type-pairs type))
+ (count (length pairs))
+ (chars (loop named outer
+ for (low . high) in pairs
nconc (loop for code from low upto high
- collect (sb!xc:code-char code))))))))
+ collect (sb!xc:code-char code)
+ when (minusp (decf count))
+ do (return-from outer t)))))
+ (if (eq chars t)
+ `(character-set ,pairs)
+ `(member ,@chars))))))
(!define-type-method (character-set :singleton-p) (type)
(let* ((pairs (character-set-type-pairs type))