[Sbcl-commits] CVS: sbcl/src/compiler fndb.lisp,1.40,1.41 seqtran.lisp,1.33,1.34 typetran.lisp,1.28,1.29

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory usw-pr-cvs1:/tmp/cvs-serv13828/src/compiler

Modified Files:
	fndb.lisp seqtran.lisp typetran.lisp 
Log Message:
0.7.8.8:
	Reintroduce patch to fix handling of type arguments to
		MAP/MERGE/... as per CSR sbcl-devel 2002-10-02
	... changes from 0.7.7.33 version:
		* smarter MAKE-SEQUENCE-LIKE implementation
		* reintroduction of (COERCE <foo> 'SIMPLE-VECTOR)
		  transform
		* one or two more deleted symbols from
		  package-data-list.lisp-expr
	Performance problems are gone, I think.


Index: fndb.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/fndb.lisp,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -d -r1.40 -r1.41
--- fndb.lisp	21 Sep 2002 10:24:08 -0000	1.40
+++ fndb.lisp	2 Oct 2002 12:09:17 -0000	1.41
@@ -36,12 +36,8 @@
   ;; is FOLDABLE at all. Check this.
   (movable #-sb-xc-host foldable)
   :derive-type (result-type-specifier-nth-arg 2))
-(defknown list-to-simple-string* (list) simple-string)
-(defknown list-to-bit-vector* (list) bit-vector)
 (defknown list-to-vector* (list type-specifier) vector)
-(defknown list-to-simple-vector* (list) simple-vector)
 (defknown vector-to-vector* (vector type-specifier) vector)
-(defknown vector-to-simple-string* (vector) vector)
 
 (defknown type-of (t) t (foldable flushable))
 

Index: seqtran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- seqtran.lisp	23 Sep 2002 16:18:20 -0000	1.33
+++ seqtran.lisp	2 Oct 2002 12:09:18 -0000	1.34
@@ -652,10 +652,12 @@
 ;;; %CONCATENATE (with a DEFTRANSFORM to translate constant RTYPE to
 ;;; CTYPE before calling %CONCATENATE) which is comparably efficient,
 ;;; at least once DYNAMIC-EXTENT works.
-#+nil ; FIXME: currently commented out because of bug 188
+;;;
+;;; FIXME: currently KLUDGEed because of bug 188
 (deftransform concatenate ((rtype &rest sequences)
 			   (t &rest simple-string)
-			   simple-string)
+			   simple-string
+			   :policy (< safety 3))
   (collect ((lets)
 	    (forms)
 	    (all-lengths)
@@ -670,16 +672,19 @@
 	(forms `(bit-bash-copy ,n-seq ,vector-data-bit-offset
 			       res start
 			       ,n-length))
-	(forms `(setq start (+ start ,n-length)))))
+	(forms `(setq start (opaque-identity (+ start ,n-length))))))
     `(lambda (rtype ,@(args))
        (declare (ignore rtype))
-       (let* (,@(lets)
-	      (res (make-string (truncate (the index (+ ,@(all-lengths)))
-					  sb!vm:n-byte-bits)))
-	      (start ,vector-data-bit-offset))
-	 (declare (type index start ,@(all-lengths)))
-	 ,@(forms)
-	 res))))
+       ;; KLUDGE
+       (flet ((opaque-identity (x) x))
+	 (declare (notinline opaque-identity))
+	 (let* (,@(lets)
+		  (res (make-string (truncate (the index (+ ,@(all-lengths)))
+					      sb!vm:n-byte-bits)))
+		  (start ,vector-data-bit-offset))
+	   (declare (type index start ,@(all-lengths)))
+	   ,@(forms)
+	   res)))))
 
 ;;;; CONS accessor DERIVE-TYPE optimizers
 

Index: typetran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/typetran.lisp,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- typetran.lisp	23 Sep 2002 16:18:21 -0000	1.28
+++ typetran.lisp	2 Oct 2002 12:09:18 -0000	1.29
@@ -529,7 +529,7 @@
 
 ;;;; coercion
 
-(deftransform coerce ((x type) (* *) *)
+(deftransform coerce ((x type) (* *) * :node node)
   (unless (constant-continuation-p type)
     (give-up-ir1-transform))
   (let ((tspec (ir1-transform-specifier-type (continuation-value type))))
@@ -544,8 +544,12 @@
 	     ;; FIXME: #!+long-float (t ,(error "LONG-FLOAT case needed"))
 	     ((csubtypep tspec (specifier-type 'float))
 	      '(%single-float x))
-	     ((csubtypep tspec (specifier-type 'simple-vector))
-	      '(coerce-to-simple-vector x))
+	     ((and (csubtypep tspec (specifier-type 'simple-vector))
+		   (policy node (< safety 3)))
+	      `(if (simple-vector-p x)
+		   x
+		   (replace (make-array (length x)) x)))
+	     ;; FIXME: other VECTOR types?
 	     (t
 	      (give-up-ir1-transform)))))))