From: Christophe R. <cr...@us...> - 2002-10-02 12:09:21
|
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))))))) |