0.8.3.55:

[sbcl.git] / src / compiler / typetran.lisp

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index e198379..9624814 100644 (file)
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -163,12 +163,12 @@
        (declare (optimize (safety 0)))
        (and ,@(when low
                (if (consp low)
-                   `((> (the ,base ,n-object) ,(car low)))
-                   `((>= (the ,base ,n-object) ,low))))
+                   `((> (truly-the ,base ,n-object) ,(car low)))
+                   `((>= (truly-the ,base ,n-object) ,low))))
            ,@(when high
                (if (consp high)
-                   `((< (the ,base ,n-object) ,(car high)))
-                   `((<= (the ,base ,n-object) ,high))))))))
+                   `((< (truly-the ,base ,n-object) ,(car high)))
+                   `((<= (truly-the ,base ,n-object) ,high))))))))
 
 ;;; Do source transformation of a test of a known numeric type. We can
 ;;; assume that the type doesn't have a corresponding predicate, since
@@ -189,7 +189,11 @@
 (defun source-transform-numeric-typep (object type)
   (let* ((class (numeric-type-class type))
         (base (ecase class
-                (integer (containing-integer-type type))
+                (integer (containing-integer-type
+                           (if (numeric-type-complexp type)
+                               (modified-numeric-type type
+                                                      :complexp :real)
+                               type)))
                 (rational 'rational)
                 (float (or (numeric-type-format type) 'float))
                 ((nil) 'real))))
@@ -200,8 +204,8 @@
               ,(transform-numeric-bound-test n-object type base)))
        (:complex
         `(and (complexp ,n-object)
-              ,(once-only ((n-real `(realpart (the complex ,n-object)))
-                           (n-imag `(imagpart (the complex ,n-object))))
+              ,(once-only ((n-real `(realpart (truly-the complex ,n-object)))
+                           (n-imag `(imagpart (truly-the complex ,n-object))))
                  `(progn
                     ,n-imag ; ignorable
                     (and (typep ,n-real ',base)
@@ -220,8 +224,8 @@
   (let ((spec (hairy-type-specifier type)))
     (cond ((unknown-type-p type)
           (when (policy *lexenv* (> speed inhibit-warnings))
-            (compiler-note "can't open-code test of unknown type ~S"
-                           (type-specifier type)))
+            (compiler-notify "can't open-code test of unknown type ~S"
+                             (type-specifier type)))
           `(%typep ,object ',spec))
          (t
           (ecase (first spec)
@@ -245,17 +249,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)))
@@ -272,10 +279,8 @@
 (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))))))
+    (let ((car-test-p (not (type= car-type *universal-type*)))
+         (cdr-test-p (not (type= cdr-type *universal-type*))))
       (if (and (not car-test-p) (not cdr-test-p))
          `(consp ,object)
          (once-only ((n-obj object))