(wild1 (eq eltype1 *wild-type*))
(wild2 (eq eltype2 *wild-type*))
(e2 nil))
- ;; This is possibly a bit more conservative then it needs to be:
- ;; it seems that wild eltype in either should lead to wild eltype
- ;; in result, but the rest of the type-system doesn't seem too
- ;; happy about that. --NS 2006-08-23
- (when (and (or (and wild1 wild2)
- (and (not (or wild1 wild2))
- (or (setf e2 (csubtypep eltype1 eltype2))
- (csubtypep eltype2 eltype1))))
- (type= stype1 stype2))
+ (when (or wild1 wild2
+ (and (or (setf e2 (csubtypep eltype1 eltype2))
+ (csubtypep eltype2 eltype1))
+ (type= stype1 stype2)))
(make-array-type
:dimensions (cond ((or (eq dims1 '*) (eq dims2 '*))
'*)
'*))
:complexp (if (eq complexp1 complexp2) complexp1 :maybe)
:element-type (if (or wild2 e2) eltype2 eltype1)
- :specialized-element-type stype1))))
+ :specialized-element-type (if wild2 stype2 stype1)))))
(!define-type-method (array :simple-intersection2) (type1 type2)
(declare (type array-type type1 type2))
;;; mechanically unparsed.
(!define-type-method (intersection :unparse) (type)
(declare (type ctype type))
- (or (find type '(ratio keyword) :key #'specifier-type :test #'type=)
+ (or (find type '(ratio keyword compiled-function) :key #'specifier-type :test #'type=)
`(and ,@(mapcar #'type-specifier (intersection-type-types type)))))
;;; shared machinery for type equality: true if every type in the set
(!define-type-method (character-set :negate) (type)
(let ((pairs (character-set-type-pairs type)))
(if (and (= (length pairs) 1)
- (= (caar pairs) 0)
- (= (cdar pairs) (1- sb!xc:char-code-limit)))
- (make-negation-type :type type)
- (let ((not-character
- (make-negation-type
- :type (make-character-set-type
- :pairs '((0 . #.(1- sb!xc:char-code-limit)))))))
- (type-union
- not-character
- (make-character-set-type
- :pairs (let (not-pairs)
- (when (> (caar pairs) 0)
- (push (cons 0 (1- (caar pairs))) not-pairs))
- (do* ((tail pairs (cdr tail))
- (high1 (cdar tail))
- (low2 (caadr tail)))
- ((null (cdr tail))
- (when (< (cdar tail) (1- sb!xc:char-code-limit))
- (push (cons (1+ (cdar tail))
- (1- sb!xc:char-code-limit))
- not-pairs))
- (nreverse not-pairs))
- (push (cons (1+ high1) (1- low2)) not-pairs)))))))))
+ (= (caar pairs) 0)
+ (= (cdar pairs) (1- sb!xc:char-code-limit)))
+ (make-negation-type :type type)
+ (let ((not-character
+ (make-negation-type
+ :type (make-character-set-type
+ :pairs '((0 . #.(1- sb!xc:char-code-limit)))))))
+ (type-union
+ not-character
+ (make-character-set-type
+ :pairs (let (not-pairs)
+ (when (> (caar pairs) 0)
+ (push (cons 0 (1- (caar pairs))) not-pairs))
+ (do* ((tail pairs (cdr tail))
+ (high1 (cdar tail) (cdar tail))
+ (low2 (caadr tail) (caadr tail)))
+ ((null (cdr tail))
+ (when (< (cdar tail) (1- sb!xc:char-code-limit))
+ (push (cons (1+ (cdar tail))
+ (1- sb!xc:char-code-limit))
+ not-pairs))
+ (nreverse not-pairs))
+ (push (cons (1+ high1) (1- low2)) not-pairs)))))))))
(!define-type-method (character-set :unparse) (type)
(cond