+(!define-type-method (intersection :complex-subtypep-arg2) (type1 type2)
+ (%intersection-complex-subtypep-arg2 type1 type2))
+
+;;; FIXME: This will look eeriely familiar to readers of the UNION
+;;; :SIMPLE-INTERSECTION2 :COMPLEX-INTERSECTION2 method. That's
+;;; because it was generated by cut'n'paste methods. Given that
+;;; intersections and unions have all sorts of symmetries known to
+;;; mathematics, it shouldn't be beyond the ken of some programmers to
+;;; reflect those symmetries in code in a way that ties them together
+;;; more strongly than having two independent near-copies :-/
+(!define-type-method (intersection :simple-union2 :complex-union2)
+ (type1 type2)
+ ;; Within this method, type2 is guaranteed to be an intersection
+ ;; type:
+ (aver (intersection-type-p type2))
+ ;; Make sure to call only the applicable methods...
+ (cond ((and (intersection-type-p type1)
+ (%intersection-simple-subtypep type1 type2)) type2)
+ ((and (intersection-type-p type1)
+ (%intersection-simple-subtypep type2 type1)) type1)
+ ((and (not (intersection-type-p type1))
+ (%intersection-complex-subtypep-arg2 type1 type2))
+ type2)
+ ((and (not (intersection-type-p type1))
+ (%intersection-complex-subtypep-arg1 type2 type1))
+ type1)
+ (t
+ (let ((accumulator *universal-type*))
+ (dolist (t2 (intersection-type-types type2) accumulator)
+ (let ((union (type-union type1 t2)))
+ (when (union-type-p union)
+ ;; we give up here -- there are all sorts of ordering
+ ;; worries, but it's better than before. Doing
+ ;; exactly the same as in the UNION
+ ;; :SIMPLE/:COMPLEX-INTERSECTION2 method causes stack
+ ;; overflow with the mutual recursion never bottoming
+ ;; out.
+ (return nil))
+ (setf accumulator
+ (type-intersection2 accumulator union))
+ ;; When our result isn't simple any more (because
+ ;; TYPE-INTERSECTION2 was unable to give us a simple
+ ;; result)
+ (unless accumulator
+ (return nil))))))))
+