X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcross-type.lisp;h=e431dbb0ba3950daf45579d216a9ea7950cc3e24;hb=0395c15ff8394bfaaed03050c1a7a131f197a732;hp=730a764e026ee36ccdf674109fa4c3966af8993d;hpb=edf8d3701ba59bd9f0c1bd027f3179b98250cfd0;p=sbcl.git

diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp
index 730a764..e431dbb 100644
--- a/src/code/cross-type.lisp
+++ b/src/code/cross-type.lisp
@@ -108,7 +108,7 @@
 ;;; T unless it's certain) and the second value to tell whether it's
 ;;; certain.
 (defun cross-typep (host-object raw-target-type)
-  (let ((target-type (type-expand raw-target-type)))
+  (let ((target-type (typexpand raw-target-type)))
     (flet ((warn-and-give-up ()
            ;; We don't have to keep track of this as long as system
            ;; performance is acceptable, since giving up
@@ -214,12 +214,26 @@
                     (values (typep host-object target-type) t))
                    (t
                     (values nil t))))
-            (;; Complexes suffer the same kind of problems as arrays
+            (;; Complexes suffer the same kind of problems as arrays.
+             ;; Our dumping logic is based on contents, however, so
+             ;; reasoning about them should be safe
              (and (not (hairy-type-p (values-specifier-type target-type)))
                   (sb!xc:subtypep target-type 'cl:complex))
              (if (complexp host-object)
-                 (warn-and-give-up) ; general-case complexes being way too hard
-                 (values nil t))) ; but "obviously not a complex" being easy
+                 (let ((re (realpart host-object))
+                       (im (imagpart host-object)))
+                   (if (or (and (eq target-type 'complex)
+                                (typep re 'rational) (typep im 'rational))
+                           (and (equal target-type '(cl:complex single-float))
+                                (typep re 'single-float) (typep im 'single-float))
+                           (and (equal target-type '(cl:complex double-float))
+                                (typep re 'double-float) (typep im 'double-float)))
+                       (values t t)
+                       (progn
+                         ;; We won't know how to dump it either.
+                         (warn "Host complex too complex: ~S" host-object)
+                         (warn-and-give-up))))
+                 (values nil t)))
             ;; Some types require translation between the cross-compilation
             ;; host Common Lisp and the target SBCL.
             ((target-type-is-in '(classoid))