0.9.0.14:

[sbcl.git] / src / code / cross-type.lisp

diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp
index 228496f..47fc196 100644 (file)
--- a/src/code/cross-type.lisp
+++ b/src/code/cross-type.lisp
@@ -82,11 +82,14 @@
                  'fixnum)
                 (t
                  'integer)))
+          ((subtypep raw-result 'simple-string)
+           `(simple-base-string ,(length object)))
+          ((subtypep raw-result 'string) 'base-string)
          ((some (lambda (type) (subtypep raw-result type))
                 '(array character list symbol))
           raw-result)
          (t
-          (error "can't handle TYPE-OF ~S in cross-compilation")))))
+          (error "can't handle TYPE-OF ~S in cross-compilation" object)))))
 
 ;;; Is SYMBOL in the CL package? Note that we're testing this on the
 ;;; cross-compilation host, which could do things any old way. In
@@ -148,14 +151,14 @@
             (typep target-type 'class)
             (bug "We don't support CROSS-TYPEP of CLASS type specifiers"))
            ((and (symbolp target-type)
-                 (find-class target-type nil)
-                 (subtypep target-type 'sb!kernel::structure!object))
-            (values (typep host-object target-type) t))
-           ((and (symbolp target-type)
                  (find-classoid target-type nil)
                  (sb!xc:subtypep target-type 'cl:structure-object)
                  (typep host-object '(or symbol number list character)))
             (values nil t))
+           ((and (symbolp target-type)
+                 (find-class target-type nil)
+                 (subtypep target-type 'sb!kernel::structure!object))
+            (values (typep host-object target-type) t))
            (;; easy cases of arrays and vectors
             (target-type-is-in
              '(array simple-string simple-vector string vector))
@@ -184,7 +187,7 @@
             ;; we don't continue doing it after we someday patch
             ;; SBCL's type system so that * is no longer a type, we
             ;; make this assertion. -- WHN 2001-08-08
-            (aver (typep (specifier-type '*) 'named-type))
+            (aver (typep (values-specifier-type '*) 'named-type))
             (values t t))
            (;; Many simple types are guaranteed to correspond exactly
             ;; between any host ANSI Common Lisp and the target
@@ -360,6 +363,11 @@
      (make-member-type :members (list x)))
     (number
      (ctype-of-number x))
+    (string
+     (make-array-type :dimensions (array-dimensions x)
+                      :complexp (not (typep x 'simple-array))
+                      :element-type (specifier-type 'base-char)
+                      :specialized-element-type (specifier-type 'base-char)))
     (array
      (let ((etype (specifier-type (array-element-type x))))
        (make-array-type :dimensions (array-dimensions x)
@@ -371,7 +379,7 @@
      (cond ((typep x 'standard-char)
            ;; (Note that SBCL doesn't distinguish between BASE-CHAR and
            ;; CHARACTER.)
-           (find-classoid 'base-char))
+           (specifier-type 'base-char))
           ((not (characterp x))
            nil)
           (t