X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-type.lisp;h=930ea76bb560839c1fccbb80419a5d313cfe0a98;hb=f8893c7c658bf9d9e0757c63e47af2fdea810f04;hp=b2cedaf2c46b295583b2d8c1336642fd8832d969;hpb=7ff14ce5fb7d138d2cd39eb6364e5ae175ac1838;p=sbcl.git

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index b2cedaf..930ea76 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2810,14 +2810,21 @@
 	    
 (!define-type-method (cons :simple-intersection2) (type1 type2)
   (declare (type cons-type type1 type2))
-  (let (car-int2
-	cdr-int2)
-    (and (setf car-int2 (type-intersection2 (cons-type-car-type type1)
-					    (cons-type-car-type type2)))
-	 (setf cdr-int2 (type-intersection2 (cons-type-cdr-type type1)
-					    (cons-type-cdr-type type2)))
-	 (make-cons-type car-int2 cdr-int2))))
-
+  (let ((car-int2 (type-intersection2 (cons-type-car-type type1)
+				      (cons-type-car-type type2)))
+	(cdr-int2 (type-intersection2 (cons-type-cdr-type type1)
+				      (cons-type-cdr-type type2))))
+    (cond
+      ((and car-int2 cdr-int2) (make-cons-type car-int2 cdr-int2))
+      (car-int2 (make-cons-type car-int2
+				(type-intersection
+				 (cons-type-cdr-type type1)
+				 (cons-type-cdr-type type2))))
+      (cdr-int2 (make-cons-type
+		 (type-intersection (cons-type-car-type type1)
+				    (cons-type-car-type type2))
+		 cdr-int2)))))
+				 
 ;;; Return the type that describes all objects that are in X but not
 ;;; in Y. If we can't determine this type, then return NIL.
 ;;;