- (union-type
- (dolist (mem (union-type-types type) (values nil t))
- (multiple-value-bind (val win) (ctypep obj mem)
- (unless win (return (values nil nil)))
- (when val (return (values t t))))))
+ (compound-type
+ (let ((certain? t))
+ (etypecase type
+ ;; FIXME: The cases here are very similar to #'EVERY/TYPE and
+ ;; #'ANY/TYPE. It would be good to fix them so that they
+ ;; share the same code. (That will require making sure that
+ ;; the two-value return convention for CTYPEP really is
+ ;; exactly compatible with the two-value convention the
+ ;; quantifier/TYPE functions operate on, and probably also
+ ;; making sure that things are inlined and defined early
+ ;; enough that consing can be avoided.)
+ (union-type
+ (dolist (mem (union-type-types type) (values nil certain?))
+ (multiple-value-bind (val win) (ctypep obj mem)
+ (if win
+ (when val (return (values t t)))
+ (setf certain? nil)))))
+ (intersection-type
+ (dolist (mem (intersection-type-types type)
+ (if certain? (values t t) (values nil nil)))
+ (multiple-value-bind (val win) (ctypep obj mem)
+ (if win
+ (unless val (return (values nil t)))
+ (setf certain? nil))))))))