X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-type.lisp;h=a4d31ab7ae6afccc49788eed41be958e66cd7015;hb=25fe91bf63fd473d9316675b0e0ca9be0079e9eb;hp=2fb73b6646dd7056ea560f3c7dcaf2f772010c7e;hpb=cb43defd8ce791c9c5a8302c0bca20fcd1b60749;p=sbcl.git

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 2fb73b6..a4d31ab 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2418,15 +2418,10 @@ used for a COMPLEX component.~:@>"
           (wild1 (eq eltype1 *wild-type*))
           (wild2 (eq eltype2 *wild-type*))
           (e2 nil))
-     ;; This is possibly a bit more conservative then it needs to be:
-     ;; it seems that wild eltype in either should lead to wild eltype
-     ;; in result, but the rest of the type-system doesn't seem too
-     ;; happy about that. --NS 2006-08-23
-     (when (and (or (and wild1 wild2)
-                    (and (not (or wild1 wild2))
-                         (or (setf e2 (csubtypep eltype1 eltype2))
-                             (csubtypep eltype2 eltype1))))
-                (type= stype1 stype2))
+     (when (or wild1 wild2
+               (and (or (setf e2 (csubtypep eltype1 eltype2))
+                        (csubtypep eltype2 eltype1))
+                    (type= stype1 stype2)))
        (make-array-type
         :dimensions (cond ((or (eq dims1 '*) (eq dims2 '*))
                            '*)
@@ -2439,7 +2434,7 @@ used for a COMPLEX component.~:@>"
                            '*))
         :complexp (if (eq complexp1 complexp2) complexp1 :maybe)
         :element-type (if (or wild2 e2) eltype2 eltype1)
-        :specialized-element-type stype1))))
+        :specialized-element-type (if wild2 stype2 stype1)))))
 
 (!define-type-method (array :simple-intersection2) (type1 type2)
   (declare (type array-type type1 type2))
@@ -2664,7 +2659,7 @@ used for a COMPLEX component.~:@>"
 ;;; mechanically unparsed.
 (!define-type-method (intersection :unparse) (type)
   (declare (type ctype type))
-  (or (find type '(ratio keyword) :key #'specifier-type :test #'type=)
+  (or (find type '(ratio keyword compiled-function) :key #'specifier-type :test #'type=)
       `(and ,@(mapcar #'type-specifier (intersection-type-types type)))))
 
 ;;; shared machinery for type equality: true if every type in the set
@@ -3109,29 +3104,29 @@ used for a COMPLEX component.~:@>"
 (!define-type-method (character-set :negate) (type)
   (let ((pairs (character-set-type-pairs type)))
     (if (and (= (length pairs) 1)
-            (= (caar pairs) 0)
-            (= (cdar pairs) (1- sb!xc:char-code-limit)))
-       (make-negation-type :type type)
-       (let ((not-character
-              (make-negation-type
-               :type (make-character-set-type
-                      :pairs '((0 . #.(1- sb!xc:char-code-limit)))))))
-         (type-union
-          not-character
-          (make-character-set-type
-           :pairs (let (not-pairs)
-                    (when (> (caar pairs) 0)
-                      (push (cons 0 (1- (caar pairs))) not-pairs))
-                    (do* ((tail pairs (cdr tail))
-                          (high1 (cdar tail))
-                          (low2 (caadr tail)))
-                         ((null (cdr tail))
-                          (when (< (cdar tail) (1- sb!xc:char-code-limit))
-                            (push (cons (1+ (cdar tail))
-                                        (1- sb!xc:char-code-limit))
-                                  not-pairs))
-                          (nreverse not-pairs))
-                      (push (cons (1+ high1) (1- low2)) not-pairs)))))))))
+             (= (caar pairs) 0)
+             (= (cdar pairs) (1- sb!xc:char-code-limit)))
+        (make-negation-type :type type)
+        (let ((not-character
+               (make-negation-type
+                :type (make-character-set-type
+                       :pairs '((0 . #.(1- sb!xc:char-code-limit)))))))
+          (type-union
+           not-character
+           (make-character-set-type
+            :pairs (let (not-pairs)
+                     (when (> (caar pairs) 0)
+                       (push (cons 0 (1- (caar pairs))) not-pairs))
+                     (do* ((tail pairs (cdr tail))
+                           (high1 (cdar tail) (cdar tail))
+                           (low2 (caadr tail) (caadr tail)))
+                          ((null (cdr tail))
+                           (when (< (cdar tail) (1- sb!xc:char-code-limit))
+                             (push (cons (1+ (cdar tail))
+                                         (1- sb!xc:char-code-limit))
+                                   not-pairs))
+                           (nreverse not-pairs))
+                       (push (cons (1+ high1) (1- low2)) not-pairs)))))))))
 
 (!define-type-method (character-set :unparse) (type)
   (cond