X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-tran.lisp;h=a78cf36fb6a8f4b4b8c708988f393e65bcb88ea7;hb=68c539ab90bb39f342229e68bf9286f63824597a;hp=6d90e85f93adcb6309310c8bbf3874ca6fb78698;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 6d90e85..a78cf36 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -18,9 +18,9 @@
 (defconstant vector-data-bit-offset
   (* sb!vm:vector-data-offset sb!vm:word-bits))
 
-;;; We need to define these predicates, since the TYPEP source transform picks
-;;; whichever predicate was defined last when there are multiple predicates for
-;;; equivalent types.
+;;; We need to define these predicates, since the TYPEP source
+;;; transform picks whichever predicate was defined last when there
+;;; are multiple predicates for equivalent types.
 (def-source-transform short-float-p (x) `(single-float-p ,x))
 #!-long-float
 (def-source-transform long-float-p (x) `(double-float-p ,x))
@@ -127,22 +127,22 @@
 			  new-value)))))
 
 (deftransform data-vector-set ((array index new-value)
-			       (simple-array t t))
+                               (simple-array t t))
   (let ((array-type (continuation-type array)))
     (unless (array-type-p array-type)
       (give-up-ir1-transform))
     (let ((dims (array-type-dimensions array-type)))
       (when (or (atom dims) (= (length dims) 1))
-	(give-up-ir1-transform))
+        (give-up-ir1-transform))
       (let ((el-type (array-type-element-type array-type))
-	    (total-size (if (member '* dims)
-			    '*
-			    (reduce #'* dims))))
-	`(data-vector-set (truly-the (simple-array ,(type-specifier el-type)
-						   (,total-size))
-				     (%array-data-vector array))
-			  index
-			  new-value)))))
+            (total-size (if (member '* dims)
+                            '*
+                            (reduce #'* dims))))
+        `(data-vector-set (truly-the (simple-array ,(type-specifier el-type)
+                                                   (,total-size))
+                                     (%array-data-vector array))
+                          index
+                          new-value)))))
 
 ;;; transforms for getting at simple arrays of (UNSIGNED-BYTE N) when (< N 8)
 ;;;
@@ -179,44 +179,6 @@
   (frob (simple-array (unsigned-byte 2) (*)) 2)
   (frob (simple-array (unsigned-byte 4) (*)) 4))
 
-;;;; simple string transforms
-;;;;
-;;;; Note: CMU CL had more of these, including transforms for
-;;;; functions which cons. In SBCL, we've gotten rid of the transforms
-;;;; for functions which cons, since our GC overhead is sufficiently
-;;;; large that it doesn't seem worth it to try to economize on
-;;;; function call overhead or on the overhead of runtime type
-;;;; dispatch in AREF.
-
-;;; FIXME: Shouldn't we be testing for legality of
-;;;   * START1, START2, END1, and END2 indices?
-;;;   * size of copied string relative to destination string?
-;;; (Either there should be tests conditional on SAFETY>=SPEED, or
-;;; the transform should be conditional on SPEED>SAFETY.)
-;;;
-;;; FIXME: Also, the transform should probably be dependent on
-;;; SPEED>SPACE.
-(deftransform replace ((string1 string2 &key (start1 0) (start2 0)
-				end1 end2)
-		       (simple-string simple-string &rest t))
-  `(locally
-     (declare (optimize (safety 0)))
-     (bit-bash-copy string2
-		    (the index
-			 (+ (the index (* start2 sb!vm:byte-bits))
-			    ,vector-data-bit-offset))
-		    string1
-		    (the index
-			 (+ (the index (* start1 sb!vm:byte-bits))
-			    ,vector-data-bit-offset))
-		    (the index
-			 (* (min (the index (- (or end1 (length string1))
-					       start1))
-				 (the index (- (or end2 (length string2))
-					       start2)))
-			    sb!vm:byte-bits)))
-     string1))
-
 ;;;; bit vector hackery
 
 ;;; SIMPLE-BIT-VECTOR bit-array operations are transformed to a word loop that
@@ -319,3 +281,4 @@
 (deftransform eql ((x y) (double-float double-float))
   '(and (= (double-float-low-bits x) (double-float-low-bits y))
 	(= (double-float-high-bits x) (double-float-high-bits y))))
+