X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcross-type.lisp;h=fee5884319eac9e76fecc71c62d2ef10787df61c;hb=6fa968aaa8051da23cc3153a1c0e67addbea85f6;hp=79b8cd13771aba2cffd4ccd1c2ceb3cf4c3fd765;hpb=0aecc2b20142e08068c3434273500131cb13fe2d;p=sbcl.git

diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp
index 79b8cd1..fee5884 100644
--- a/src/code/cross-type.lisp
+++ b/src/code/cross-type.lisp
@@ -162,6 +162,14 @@
              (target-type-is-in
               '(array simple-string simple-vector string vector))
              (values (typep host-object target-type) t))
+            (;; sequence is not guaranteed to be an exhaustive
+             ;; partition, but it includes at least lists and vectors.
+             (target-type-is-in '(sequence))
+             (if (or (vectorp host-object) (listp host-object))
+                 (values t t)
+                 (if (typep host-object target-type)
+                     (warn-and-give-up)
+                     (values nil t))))
             (;; general cases of vectors
              (and (not (hairy-type-p (values-specifier-type target-type)))
                   (sb!xc:subtypep target-type 'cl:vector))
@@ -341,10 +349,23 @@
 ;;; cross-compile time only.
 (defun ctypep (obj ctype)
   (check-type ctype ctype)
-  (let (;; the Common Lisp type specifier corresponding to CTYPE
-        (type (type-specifier ctype)))
-    (check-type type (or symbol cons))
-    (cross-typep obj type)))
+  ;; There is at least one possible endless recursion in the
+  ;; cross-compiler type system: (SUBTYPEP NULL (OR UNKOWN0 UNKNOWN1)
+  ;; runs out of stack. The right way would probably be to not
+  ;; implement CTYPEP in terms of TYPE-SPECIFIER (:UNPARSE, that may
+  ;; call TYPE=, that in turn may call CTYPEP). Until then, pick a few
+  ;; cherries off.
+  (cond ((member-type-p ctype)
+         (if (member obj (member-type-members ctype))
+             (values t t)
+             (values nil t)))
+        ((union-type-p ctype)
+         (any/type #'ctypep obj (union-type-types ctype)))
+        (t
+         (let ( ;; the Common Lisp type specifier corresponding to CTYPE
+               (type (type-specifier ctype)))
+           (check-type type (or symbol cons))
+           (cross-typep obj type)))))
 
 (defun ctype-of (x)
   (typecase x