X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcross-type.lisp;h=47fc196a9a684a7c371c5269e952866a274baecc;hb=3fe0010d2777b41e01ea9b4a0f894cfa40f7df1b;hp=75bb1aac3ab20d49470fb606ffa1c8a19dd8425b;hpb=f2775f0e5b50cfad198937e02ed90ee07682e125;p=sbcl.git

diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp
index 75bb1aa..47fc196 100644
--- 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
@@ -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