;;;; files for more information.
(in-package "SB!C")
-
-(file-comment
- "$Header$")
\f
;;;; mapping onto lists: the MAPFOO functions
\f
;;;; mapping onto sequences: the MAP function
-;;; Try to compile MAP efficiently when we can determine sequence
+;;; MAP is %MAP plus a check to make sure that any length specified in
+;;; the result type matches the actual result. We also wrap it in a
+;;; TRULY-THE for the most specific type we can determine.
+(deftransform map ((result-type-arg fun &rest seqs) * * :node node)
+ (let* ((seq-names (make-gensym-list (length seqs)))
+ (bare `(%map result-type-arg fun ,@seq-names))
+ (constant-result-type-arg-p (constant-continuation-p result-type-arg))
+ ;; what we know about the type of the result. (Note that the
+ ;; "result type" argument is not necessarily the type of the
+ ;; result, since NIL means the result has NULL type.)
+ (result-type (if (not constant-result-type-arg-p)
+ 'consed-sequence
+ (let ((result-type-arg-value
+ (continuation-value result-type-arg)))
+ (if (null result-type-arg-value)
+ 'null
+ result-type-arg-value)))))
+ `(lambda (result-type-arg fun ,@seq-names)
+ (truly-the ,result-type
+ ,(cond ((policy node (> speed safety))
+ bare)
+ ((not constant-result-type-arg-p)
+ `(sequence-of-checked-length-given-type ,bare
+ result-type-arg))
+ (t
+ (let ((result-ctype (specifier-type result-type)))
+ (if (array-type-p result-ctype)
+ (let* ((dims (array-type-dimensions result-ctype))
+ (dim (first dims)))
+ (if (eq dim '*)
+ bare
+ `(vector-of-checked-length-given-length ,bare
+ ,dim)))
+ bare))))))))
+
+;;; Try to compile %MAP efficiently when we can determine sequence
;;; argument types at compile time.
;;;
;;; Note: This transform was written to allow open coding of
;;; handle that case more efficiently, but it's left as an exercise to
;;; the reader, because the code is complicated enough already and I
;;; don't happen to need that functionality right now. -- WHN 20000410
-;;;
-;;; FIXME: Now that we have this transform, we should be able
-;;; to get rid of the macros MAP-TO-LIST, MAP-TO-SIMPLE,
-;;; and MAP-FOR-EFFECT.
-(deftransform map ((result-type fun &rest seqs) * *)
+(deftransform %map ((result-type fun &rest seqs) * * :policy (>= speed space))
"open code"
(unless seqs (abort-ir1-transform "no sequence args"))
(unless (constant-continuation-p result-type)
(t (give-up-ir1-transform
"internal error: unexpected sequence type"))))
(t
- (let* ((seq-args (mapcar (lambda (seq)
- (declare (ignore seq))
- (gensym "SEQ"))
- seqs))
+ (let* ((seq-args (make-gensym-list (length seqs)))
(index-bindingoids
(mapcar (lambda (seq-arg seq-supertype)
(let ((i (gensym "I")))
;; of the &REST vars.)
`(lambda (result-type fun ,@seq-args)
(declare (ignore result-type))
- (do ((really-fun (if (functionp fun)
- fun
- (%coerce-name-to-function fun)))
+ (do ((really-fun (%coerce-callable-to-function fun))
,@index-bindingoids
(acc nil))
((or ,@tests)
(sb!impl::%sp-string-compare
string1 start1 (or end1 (length string1))
string2 start2 (or end2 (length string2)))))))
+\f
+;;;; 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))))
projects / sbcl.git / blobdiff