0.pre8.103:

        * Added open coding of MAP-INTO for a vector destination
          (reported by Brian Downing on c.l.l)

NEWS

@@ -1635,7 +1635,7 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
     sbcl --eval "(defpackage :foo)" --eval "(print 'foo::bar)" now work
     as the user might reasonably expect.)
   * minor incompatible change: *STANDARD-INPUT* is now only an
-    INPUT-STREAM, not a BIDIRECTIONAL-STREAM.  (thanks to Antonio 
+    INPUT-STREAM, not a BIDIRECTIONAL-STREAM.  (thanks to Antonio
     Martinez)
   * minor incompatible change: Y-OR-N-P is now character-oriented, not
     line oriented.  Also, YES-OR-NO-P now works without errors.
@@ -1664,7 +1664,7 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
     details.
   * Garbage collection refactoring: user-visible change is that a
     call to the GC function during WITHOUT-GCING will not do garbage
-    collection until the end of the WITHOUT-GCING.  If you were doing 
+    collection until the end of the WITHOUT-GCING.  If you were doing
     this you were probably losing anyway.
   * sb-aclrepl module improvements: an integrated inspector, added
     repl features, and a bug fix to :trace command.
@@ -1673,6 +1673,8 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
     TYPEP the latter but not the former.
   * compiler issues a full WARNING on calling of an undefined function
     with a name from the CL package.
+  * MAP-INTO for a vector destination is open coded. (reported by
+    Brian Downing on c.l.l)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** COPY-ALIST now signals an error if its argument is a dotted
        list;

src/compiler/constraint.lisp

@@ -540,19 +540,6 @@
                              (when con
                                (constrain-ref-type node con cons))))))))
 
-;;; Return true if VAR would have to be closed over if environment
-;;; analysis ran now (i.e. if there are any uses that have a different
-;;; home lambda than VAR's home.)
-(defun closure-var-p (var)
-  (declare (type lambda-var var))
-  (let ((home (lambda-home (lambda-var-home var))))
-    (flet ((frob (l)
-	     (dolist (node l nil)
-	       (unless (eq (node-home-lambda node) home)
-		 (return t)))))
-      (or (frob (leaf-refs var))
-	  (frob (basic-var-sets var))))))
-
 ;;; Give an empty constraints set to any var that doesn't have one and
 ;;; isn't a set closure var. Since a var that we previously rejected
 ;;; looks identical to one that is new, so we optimistically keep

src/compiler/fndb.lisp

@@ -474,6 +474,11 @@
 (defknown %map-to-nil-on-vector (callable vector) null (flushable call))
 (defknown %map-to-nil-on-sequence (callable sequence) null (flushable call))
 
+(defknown map-into (sequence callable &rest sequence)
+  sequence
+  (call)
+  :derive-type #'result-type-first-arg)
+
 ;;; returns the result from the predicate...
 (defknown some (callable sequence &rest sequence) t
   (foldable unsafely-flushable call))

src/compiler/ir1util.lisp

@@ -1300,6 +1300,21 @@
 		     :type (ctype-of object)
 		     :where-from :defined)))
 
+;;; Return true if VAR would have to be closed over if environment
+;;; analysis ran now (i.e. if there are any uses that have a different
+;;; home lambda than VAR's home.)
+(defun closure-var-p (var)
+  (declare (type lambda-var var))
+  (let ((home (lambda-var-home var)))
+    (cond ((eq (functional-kind home) :deleted)
+           nil)
+          (t (let ((home (lambda-home home)))
+               (flet ((frob (l)
+                        (find home l :key #'node-home-lambda
+                              :test-not #'eq)))
+                 (or (frob (leaf-refs var))
+                     (frob (basic-var-sets var)))))))))
+
 ;;; If there is a non-local exit noted in ENTRY's environment that
 ;;; exits to CONT in that entry, then return it, otherwise return NIL.
 (defun find-nlx-info (entry cont)

src/compiler/seqtran.lisp

@@ -230,6 +230,37 @@
 		    (let ((dacc (funcall really-fun ,@values)))
 		      (declare (ignorable dacc))
 		      ,push-dacc))))))))))
+
+;;; MAP-INTO
+(deftransform map-into ((result fun &rest seqs)
+                        (vector * &rest *)
+                        *)
+  "open code"
+  (let ((seqs-names (mapcar (lambda (x)
+                              (declare (ignore x))
+                              (gensym))
+                            seqs)))
+    `(lambda (result fun ,@seqs-names)
+       (let ((length (array-dimension result 0))
+             (i 0))
+         (declare (type index i))
+         (declare (ignorable i))
+         ,(cond ((null seqs)
+                 `(dotimes (j length (setq i length))
+                    (setf (aref result j) (funcall fun))))
+                (t
+                 `(block nil
+                    (map nil
+                         (lambda (,@seqs-names)
+                           (when (= i length) (return))
+                           (setf (aref result i)
+                                 (funcall fun ,@seqs-names))
+                           (incf i))
+                         ,@seqs-names))))
+         (when (array-has-fill-pointer-p result)
+           (setf (fill-pointer result) i))
+         result))))
+
 
 ;;; FIXME: once the confusion over doing transforms with known-complex
 ;;; arrays is over, we should also transform the calls to (AND (ARRAY

version.lisp-expr

@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre8.102"
+"0.pre8.103"