0.pre8.103:

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

diff --git a/NEWS b/NEWS
index a409aff..386e5df 100644 (file)
--- a/NEWS
+++ b/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;

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 507eaf8..5e61624 100644 (file)
--- a/src/compiler/constraint.lisp
+++ b/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

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 80c5a7a..113cb1d 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/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))

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 7336b6d..6805e4f 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1300,6 +1300,21 @@
                     :type (ctype-of object)
                     :where-from :defined)))
 \f
+;;; 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)

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index bfea722..d67fb41 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/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))))
+
 \f
 ;;; FIXME: once the confusion over doing transforms with known-complex
 ;;; arrays is over, we should also transform the calls to (AND (ARRAY

diff --git a/version.lisp-expr b/version.lisp-expr
index eb3e298..734b445 100644 (file)
--- a/version.lisp-expr
+++ b/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"