X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Flate-type.lisp;h=147656e7a4e4efdf4e1f271faf8fc91acf0b743a;hb=bb756e3d4b19c30d4a9cd4250b606c5969613ad9;hp=341ff5136d7120e57c75159bc3460ced36a9243d;hpb=0d3d3a78055fa485985cda2df688f3cd7e9adb18;p=sbcl.git

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 341ff51..147656e 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -1736,6 +1736,21 @@
 	     (apply #'type-union
 		    (mapcar (lambda (x) (complex1 (ctype-of x)))
 			    (member-type-members ctype))))
+            ((and (typep ctype 'intersection-type)
+                  ;; FIXME: This is very much a
+                  ;; not-quite-worst-effort, but we are required to do
+                  ;; something here because of our representation of
+                  ;; RATIO as (AND RATIONAL (NOT INTEGER)): we must
+                  ;; allow users to ask about (COMPLEX RATIO).  This
+                  ;; will of course fail to work right on such types
+                  ;; as (AND INTEGER (SATISFIES ZEROP))...
+                  (let ((numbers (remove-if-not
+                                  #'numeric-type-p
+                                  (intersection-type-types ctype))))
+                    (and (car numbers)
+                         (null (cdr numbers))
+                         (eq (numeric-type-complexp (car numbers)) :real)
+                         (complex1 (car numbers))))))
 	    (t
 	     (multiple-value-bind (subtypep certainly)
 		 (csubtypep ctype (specifier-type 'real))
@@ -1743,11 +1758,12 @@
 		   (not-real)
 		   ;; ANSI just says that TYPESPEC is any subtype of
 		   ;; type REAL, not necessarily a NUMERIC-TYPE. In
-		   ;; particular, at this point TYPESPEC could legally be
-		   ;; an intersection type like (AND REAL (SATISFIES ODDP)),
-		   ;; in which case we fall through the logic above and
-		   ;; end up here, stumped.
-		   (bug "~@<(known bug #145): The type ~S is too hairy to be 
+		   ;; particular, at this point TYPESPEC could legally
+		   ;; be a hairy type like (AND NUMBER (SATISFIES
+		   ;; REALP) (SATISFIES ZEROP)), in which case we fall
+		   ;; through the logic above and end up here,
+		   ;; stumped.
+		   (bug "~@<(known bug #145): The type ~S is too hairy to be ~
                          used for a COMPLEX component.~:@>"
 			typespec)))))))))
 
@@ -3094,7 +3110,11 @@
 	      (values :complex (min num imag) (max num imag)))
 	    (values :real num num))
       (make-numeric-type :class (etypecase num
-				  (integer 'integer)
+				  (integer (if (complexp x)
+                                               (if (integerp (imagpart x))
+                                                   'integer
+                                                   'rational)
+                                               'integer))
 				  (rational 'rational)
 				  (float 'float))
 			 :format (and (floatp num) (float-format-name num))