-;;; MNA: cons compound-type patch
-;;; FIXIT: all commented out
-; ;;; Source-Transform-Cons-Typep
-; ;;;
-; ;;; If necessary recurse to check the cons type.
-; ;;;
-; (defun source-transform-cons-typep (object type)
-; (let* ((car-type (cons-type-car-type type))
-; (cdr-type (cons-type-cdr-type type)))
-; (let ((car-test-p (not (or (type= car-type *wild-type*)
-; (type= car-type (specifier-type t)))))
-; (cdr-test-p (not (or (type= cdr-type *wild-type*)
-; (type= cdr-type (specifier-type t))))))
-; (if (and (not car-test-p) (not cdr-test-p))
-; `(consp ,object)
-; (once-only ((n-obj object))
-; `(and (consp ,n-obj)
-; ,@(if car-test-p
-; `((typep (car ,n-obj)
-; ',(type-specifier car-type))))
-; ,@(if cdr-test-p
-; `((typep (cdr ,n-obj)
-; ',(type-specifier cdr-type))))))))))
+;;; Do source transformation for TYPEP of a known intersection type.
+(defun source-transform-intersection-typep (object type)
+ (once-only ((n-obj object))
+ `(and ,@(mapcar (lambda (x)
+ `(typep ,n-obj ',(type-specifier x)))
+ (intersection-type-types type)))))