From e7115ca33eaf93aee9403b994ce57cc25eb1a495 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Thu, 3 Jul 2003 07:38:52 +0000 Subject: [PATCH] 0.8.1.17: * Make sure that recursive call of SOURCE-TRANSFORM-UNION-TYPEP gets simpler argument. --- src/compiler/typetran.lisp | 25 ++++++++++++++----------- tests/compiler.pure.lisp | 4 ++++ version.lisp-expr | 2 +- 3 files changed, 19 insertions(+), 12 deletions(-) diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp index b473f7f..ccb585a 100644 --- 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 --- 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 --- 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" -- 1.7.10.4