- (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))))))))
+ (funcall (etypecase type
+ (intersection-type #'every/type)
+ (union-type #'any/type))
+ #'ctypep
+ obj
+ (compound-type-types type)))