X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Ftypetran.lisp;fp=src%2Fcompiler%2Ftypetran.lisp;h=4f1fa0599c77a83e88213499e5e3ee25f18c03e3;hb=2dfaffe8bdce30dac9b5baa4d2645d074a176b4f;hp=c1f818d5b344c12596201b7f2e7e53c9c0764048;hpb=f2218c68ed978533fc46830ac81f4517fefe5a2a;p=sbcl.git

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index c1f818d..4f1fa05 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -81,7 +81,14 @@
           ((eq type *empty-type*)
            nil)
           (t
-           (give-up-ir1-transform)))))
+           (let ((intersect (type-intersection2 type otype)))
+             (unless intersect
+               (give-up-ir1-transform))
+             (multiple-value-bind (constantp value)
+                 (type-singleton-p intersect)
+               (if constantp
+                   `(eql object ',value)
+                   (give-up-ir1-transform))))))))
 
 ;;; Flush %TYPEP tests whose result is known at compile time.
 (deftransform %typep ((object type))
@@ -554,6 +561,9 @@
     (or (when (not ctype)
           (compiler-warn "illegal type specifier for TYPEP: ~S" type)
           (return-from source-transform-typep (values nil t)))
+        (multiple-value-bind (constantp value) (type-singleton-p ctype)
+          (and constantp
+               `(eql ,object ',value)))
         (let ((pred (cdr (assoc ctype *backend-type-predicates*
                                 :test #'type=))))
           (when pred `(,pred ,object)))