From 19198944c81507369ae46522c13b30df628cb442 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 21 Oct 2000 17:32:17 +0000 Subject: [PATCH] 0.6.7.23: Use DEFTRANSFORM CONCATENATE for efficiency after all. --- src/code/seq.lisp | 2 +- src/compiler/generic/vm-tran.lisp | 38 ------------------- src/compiler/seqtran.lisp | 76 +++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 78 insertions(+), 40 deletions(-) diff --git a/src/code/seq.lisp b/src/code/seq.lisp index a4fa138..19f2aa1 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -93,7 +93,7 @@ :datum type :expected-type 'sequence :format-control - "~S is a bad type specifier for sequence functions." + "~S is not a legal type specifier for sequence functions." :format-arguments (list type)))))) (defun signal-index-too-large-error (sequence index) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 6d90e85..ea381c4 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -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 diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 83c5e4e..8c493b1 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -628,3 +628,79 @@ (sb!impl::%sp-string-compare string1 start1 (or end1 (length string1)) string2 start2 (or end2 (length string2))))))) + +;;;; string-only transforms for sequence functions +;;;; +;;;; Note: CMU CL had more of these, including transforms for +;;;; functions which cons. In SBCL, we've gotten rid of most 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. The exception is CONCATENATE, since +;;;; a full call to CONCATENATE would have to look up the sequence +;;;; type, which can be really slow. +;;;; +;;;; FIXME: It would be nicer for these transforms to work for any +;;;; calls when all arguments are vectors with the same element type, +;;;; rather than restricting them to STRINGs only. + +;;; 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)) + +;;; FIXME: It seems as though it should be possible to make a DEFUN +;;; %CONCATENATE (with a DEFTRANSFORM to translate constant RTYPE to +;;; CTYPE before calling %CONCATENATE) which is comparably efficient, +;;; at least once DYNAMIC-EXTENT works. +(deftransform concatenate ((rtype &rest sequences) + (t &rest simple-string) + simple-string) + (collect ((lets) + (forms) + (all-lengths) + (args)) + (dolist (seq sequences) + (declare (ignore seq)) + (let ((n-seq (gensym)) + (n-length (gensym))) + (args n-seq) + (lets `(,n-length (the index (* (length ,n-seq) sb!vm:byte-bits)))) + (all-lengths n-length) + (forms `(bit-bash-copy ,n-seq ,vector-data-bit-offset + res start + ,n-length)) + (forms `(setq start (+ start ,n-length))))) + `(lambda (rtype ,@(args)) + (declare (ignore rtype)) + (let* (,@(lets) + (res (make-string (truncate (the index (+ ,@(all-lengths))) + sb!vm:byte-bits))) + (start ,vector-data-bit-offset)) + (declare (type index start ,@(all-lengths))) + ,@(forms) + res)))) diff --git a/version.lisp-expr b/version.lisp-expr index e28e8a2..492f475 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string a la "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.7.22" +"0.6.7.23" -- 1.7.10.4