X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fseq.lisp;h=90036a62c0432dc9318a27ab93b4c76602a4b625;hb=87c62dadeba82095c672161e30a3611016d270fb;hp=96a67b3bb2ce97809ac7916d86d37d5e21b69f5c;hpb=151b7b5db692eb7c089e92100df0b037418e8d27;p=sbcl.git diff --git a/src/code/seq.lisp b/src/code/seq.lisp index 96a67b3..90036a6 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -373,6 +373,12 @@ ;;;; SUBSEQ ;;;; + +(define-array-dispatch vector-subseq-dispatch (array start end) + (declare (optimize speed (safety 0))) + (declare (type index start end)) + (subseq array start end)) + ;;;; The support routines for SUBSEQ are used by compiler transforms, ;;;; so we worry about dealing with END being supplied or defaulting ;;;; to NIL at this level. @@ -387,7 +393,7 @@ (end end) :check-fill-pointer t :force-inline t) - (funcall (!find-vector-subseq-fun data) data start end))) + (vector-subseq-dispatch data start end))) (defun list-subseq* (sequence start end) (declare (type list sequence) @@ -775,7 +781,7 @@ many elements are copied." (let ((,sequence ,s)) (seq-dispatch ,sequence (dolist (,e ,sequence ,return) ,@body) - (dovector (,e ,sequence ,return) ,@body) + (do-vector-data (,e ,sequence ,return) ,@body) (multiple-value-bind (state limit from-end step endp elt) (sb!sequence:make-sequence-iterator ,sequence) (do ((state state (funcall step ,sequence state from-end))) @@ -881,7 +887,7 @@ many elements are copied." (def %concatenate-to-string character) (def %concatenate-to-base-string base-char)) -;;;; MAP and MAP-INTO +;;;; MAP ;;; helper functions to handle arity-1 subcases of MAP (declaim (ftype (function (function sequence) list) %map-list-arity-1)) @@ -1045,74 +1051,79 @@ many elements are copied." first-sequence more-sequences)) +;;;; MAP-INTO + +(defmacro map-into-lambda (sequences params &body body) + (check-type sequences symbol) + `(flet ((f ,params ,@body)) + (declare (truly-dynamic-extent #'f)) + ;; Note (MAP-INTO SEQ (LAMBDA () ...)) is a different animal, + ;; hence the awkward flip between MAP and LOOP. + (if ,sequences + (apply #'map nil #'f ,sequences) + (loop (f))))) + +(define-array-dispatch vector-map-into (data start end fun sequences) + (declare (optimize speed (safety 0)) + (type index start end) + (type function fun) + (type list sequences)) + (let ((index start)) + (declare (type index index)) + (block mapping + (map-into-lambda sequences (&rest args) + (declare (truly-dynamic-extent args)) + (when (eql index end) + (return-from mapping)) + (setf (aref data index) (apply fun args)) + (incf index))) + index)) + ;;; Uses the machinery of (MAP NIL ...). For non-vectors we avoid ;;; computing the length of the result sequence since we can detect ;;; the end during mapping (if MAP even gets that far). +;;; +;;; For each result type, define a mapping function which is +;;; responsible for replacing RESULT-SEQUENCE elements and for +;;; terminating itself if the end of RESULT-SEQUENCE is reached. +;;; The mapping function is defined with MAP-INTO-LAMBDA. +;;; +;;; MAP-INTO-LAMBDAs are optimized since they are the inner loops. +;;; Because we are manually doing bounds checking with known types, +;;; safety is turned off for vectors and lists but kept for generic +;;; sequences. (defun map-into (result-sequence function &rest sequences) - (declare (truly-dynamic-extent sequences)) (let ((really-fun (%coerce-callable-to-fun function))) - ;; For each result type, define a mapping function which is - ;; responsible for replacing RESULT-SEQUENCE elements and for - ;; terminating itself if the end of RESULT-SEQUENCE is reached. - ;; - ;; The mapping function is defined with the MAP-LAMBDA macrolet, - ;; whose syntax matches that of LAMBDA. - (macrolet ((map-lambda (params &body body) - `(flet ((f ,params ,@body)) - (declare (truly-dynamic-extent #'f)) - ;; Note (MAP-INTO SEQ (LAMBDA () ...)) is a - ;; different animal, hence the awkward flip - ;; between MAP and LOOP. - (if sequences - (apply #'map nil #'f sequences) - (loop (f)))))) - ;; Optimize MAP-LAMBDAs since they are the inner loops. Because - ;; we are manually doing bounds checking with known types, turn - ;; off safety for vectors and lists but keep it for generic - ;; sequences. - (etypecase result-sequence - (vector - (locally (declare (optimize speed (safety 0))) - (with-array-data ((data result-sequence) (start) (end) - ;; MAP-INTO ignores fill pointer when mapping - :check-fill-pointer nil) - (let ((index start)) - (declare (type index index)) - (macrolet ((dispatch () - `(block mapping - (map-lambda (&rest args) - (declare (truly-dynamic-extent args)) - (when (eql index end) - (return-from mapping)) - (setf (aref data index) - (apply really-fun args)) - (incf index))))) - (typecase data - (simple-vector (dispatch)) - (otherwise (dispatch)))) - (when (array-has-fill-pointer-p result-sequence) - (setf (fill-pointer result-sequence) (- index start))))))) - (list - (let ((node result-sequence)) - (declare (type list node)) - (map-lambda (&rest args) - (declare (truly-dynamic-extent args) (optimize speed (safety 0))) - (when (null node) - (return-from map-into result-sequence)) - (setf (car node) (apply really-fun args)) - (setf node (cdr node))))) - (sequence - (multiple-value-bind (iter limit from-end) - (sb!sequence:make-sequence-iterator result-sequence) - (map-lambda (&rest args) - (declare (truly-dynamic-extent args) (optimize speed)) - (when (sb!sequence:iterator-endp result-sequence - iter limit from-end) - (return-from map-into result-sequence)) - (setf (sb!sequence:iterator-element result-sequence iter) - (apply really-fun args)) - (setf iter (sb!sequence:iterator-step result-sequence - iter from-end)))))))) + (etypecase result-sequence + (vector + (with-array-data ((data result-sequence) (start) (end) + ;; MAP-INTO ignores fill pointer when mapping + :check-fill-pointer nil) + (let ((new-end (vector-map-into data start end really-fun sequences))) + (when (array-has-fill-pointer-p result-sequence) + (setf (fill-pointer result-sequence) (- new-end start)))))) + (list + (let ((node result-sequence)) + (declare (type list node)) + (map-into-lambda sequences (&rest args) + (declare (truly-dynamic-extent args) + (optimize speed (safety 0))) + (when (null node) + (return-from map-into result-sequence)) + (setf (car node) (apply really-fun args)) + (setf node (cdr node))))) + (sequence + (multiple-value-bind (iter limit from-end) + (sb!sequence:make-sequence-iterator result-sequence) + (map-into-lambda sequences (&rest args) + (declare (truly-dynamic-extent args) (optimize speed)) + (when (sb!sequence:iterator-endp result-sequence + iter limit from-end) + (return-from map-into result-sequence)) + (setf (sb!sequence:iterator-element result-sequence iter) + (apply really-fun args)) + (setf iter (sb!sequence:iterator-step result-sequence + iter from-end))))))) result-sequence) ;;;; quantifiers @@ -2224,11 +2235,12 @@ many elements are copied." ((simple-array base-char (*)) (frob2)) ,@(when bit-frob `((simple-bit-vector - (if (and (eq #'identity key) + (if (and (typep item 'bit) + (eq #'identity key) (or (eq #'eq test) (eq #'eql test) (eq #'equal test))) - (let ((p (%bit-position (the bit item) sequence + (let ((p (%bit-position item sequence from-end start end))) (if p (values item p)