X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-tran.lisp;h=3298c81cf5fae9dff07e20ff1f6d1cb3521517db;hb=03df95052f395c205d7e5028e06bc043ee60125d;hp=7c4cc00da832822b447fa959637e725d2d98e50d;hpb=b870615b146940f661e5d0e9069ca4e16e9f483d;p=sbcl.git

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 7c4cc00..3298c81 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -41,6 +41,15 @@
 
 ;;;; simplifying HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET
 
+(deftransform hairy-data-vector-ref ((string index) (simple-string t))
+  (let ((ctype (continuation-type string)))
+    (if (array-type-p ctype)
+	;; the other transform will kick in, so that's OK
+	(give-up-ir1-transform)
+	`(typecase string
+	  ((simple-array character (*)) (data-vector-ref string index))
+	  ((simple-array nil (*)) (data-vector-ref string index))))))
+
 (deftransform hairy-data-vector-ref ((array index) (array t) * :important t)
   "avoid runtime dispatch on array element type"
   (let ((element-ctype (extract-upgraded-element-type array)))
@@ -94,6 +103,18 @@
 			  index
 			  new-value)))))
 
+(deftransform hairy-data-vector-set ((string index new-value)
+				     (simple-string t t))
+  (let ((ctype (continuation-type string)))
+    (if (array-type-p ctype)
+	;; the other transform will kick in, so that's OK
+	(give-up-ir1-transform)
+	`(typecase string
+	  ((simple-array character (*))
+	   (data-vector-set string index new-value))
+	  ((simple-array nil (*))
+	   (data-vector-set string index new-value))))))
+
 (deftransform data-vector-set ((array index new-value)
                                (simple-array t t))
   (let ((array-type (continuation-type array)))
@@ -348,7 +369,7 @@
       (memmove (sap+ (sapify dst) dst-start)
 	       (sap+ (sapify src) src-start)
 	       (- dst-end dst-start)))
-     nil))
+     (values)))
 
 ;;;; transforms for EQL of floating point values