- ;; was: (any/type #'csubtypep type1 (union-type-types type2)),
- ;; which turns out to be too restrictive, causing bug 91.
- ;;
- ;; the following reimplementation might look dodgy. It is
- ;; dodgy. It depends on the union :complex-= method not doing
- ;; very much work -- certainly, not using subtypep. Reasoning:
- (progn
- ;; At this stage, we know that type2 is a union type and type1
- ;; isn't. We might as well check this, though:
- (aver (union-type-p type2))
- (aver (not (union-type-p type1)))
- ;; A is a subset of (B1 u B2)
- ;; <=> A n (B1 u B2) = A
- ;; <=> (A n B1) u (A n B2) = A
- ;;
- ;; But, we have to be careful not to delegate this type= to
- ;; something that could invoke subtypep, which might get us
- ;; back here -> stack explosion. We therefore ensure that the
- ;; second type (which is the one that's dispatched on) is
- ;; either a union type (where we've ensured that the complex-=
- ;; method will not call subtypep) or something with no union
- ;; types involved, in which case we'll never come back here.
- ;;
- ;; If we don't do this, then e.g.
- ;; (SUBTYPEP '(MEMBER 3) '(OR (SATISFIES FOO) (SATISFIES BAR)))
- ;; would loop infinitely, as the member :complex-= method is
- ;; implemented in terms of subtypep.
- ;;
- ;; Ouch. - CSR, 2002-04-10
- (type= type1
- (apply #'type-union
- (mapcar (lambda (x) (type-intersection type1 x))
- (union-type-types type2)))))