0.8.1.17:

        * Make sure that recursive call of
          SOURCE-TRANSFORM-UNION-TYPEP gets simpler argument.

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index b473f7f..ccb585a 100644 (file)
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -245,17 +245,20 @@
 ;;; trying to optimize it.
 (defun source-transform-union-typep (object type)
   (let* ((types (union-type-types type))
-        (ltype (specifier-type 'list))
-        (mtype (find-if #'member-type-p types)))
-    (if (and mtype (csubtypep ltype type))
-       (let ((members (member-type-members mtype)))
-         (once-only ((n-obj object))
-           `(or (listp ,n-obj)
-                (typep ,n-obj
-                       '(or ,@(mapcar #'type-specifier
-                                      (remove (specifier-type 'cons)
-                                              (remove mtype types)))
-                            (member ,@(remove nil members)))))))
+        (type-list (specifier-type 'list))
+         (type-cons (specifier-type 'cons))
+        (mtype (find-if #'member-type-p types))
+         (members (when mtype (member-type-members mtype))))
+    (if (and mtype
+             (memq nil members)
+             (memq type-cons types))
+       (once-only ((n-obj object))
+          `(or (listp ,n-obj)
+               (typep ,n-obj
+                      '(or ,@(mapcar #'type-specifier
+                                     (remove type-cons
+                                             (remove mtype types)))
+                        (member ,@(remove nil members))))))
        (once-only ((n-obj object))
          `(or ,@(mapcar (lambda (x)
                           `(typep ,n-obj ',(type-specifier x)))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 64f425e..35fec3e 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -462,3 +462,7 @@
   (compile nil '(lambda (x)
                 (declare (type (simple-array (simple-string 3) (5)) x))
                 (aref (aref x 0) 0))))
+
+;; compiler failure
+(let ((f (compile nil '(lambda (x) (typep x '(not (member 0d0)))))))
+  (assert (funcall f 1d0)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 8f6bf03..8323a3c 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.1.16"
+"0.8.1.17"