- (let (;; a component of TYPE2 whose intersection with TYPE1
- ;; is nonempty
- (nontriv-t2 nil))
- (dolist (t2 (union-type-types type2) (or nontriv-t2 *empty-type*))
- (unless (eq *empty-type* (type-intersection type1 t2))
- (if nontriv-t2 ; if this is second nonempty intersection
- (return nil) ; too many: can't find nice result
- (setf nontriv-t2 t2))))))))
+ (let ((accumulator *empty-type*))
+ (dolist (t2 (union-type-types type2) accumulator)
+ (setf accumulator
+ (type-union2 accumulator
+ (type-intersection type1 t2)))
+ ;; When our result isn't simple any more
+ (when (or
+ ;; (TYPE-UNION2 couldn't find a sufficiently simple
+ ;; result, so we can't either.)
+ (null accumulator)
+ ;; (A result containing an intersection isn't
+ ;; sufficiently simple for us. FIXME: Maybe it
+ ;; should be sufficiently simple for us?
+ ;; UNION-TYPEs aren't supposed to be nested inside
+ ;; INTERSECTION-TYPEs, so if we punt with NIL,
+ ;; we're condemning the expression to become a
+ ;; HAIRY-TYPE. If it were possible for us to
+ ;; return an INTERSECTION-TYPE, then the
+ ;; INTERSECTION-TYPE-TYPES could be merged into
+ ;; the outer INTERSECTION-TYPE which may be under
+ ;; construction. E.g. if this function could
+ ;; return an intersection type, and the calling
+ ;; functions were smart enough to handle it, then
+ ;; we could simplify (AND (OR FIXNUM KEYWORD)
+ ;; SYMBOL) to KEYWORD, even though KEYWORD
+ ;; is an intersection type.)
+ (intersection-type-p accumulator))
+ (return nil)))))))