diff --git a/NEWS b/NEWS index a409aff93..386e5dfed 100644 --- 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 507eaf824..5e6162479 100644 --- 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 80c5a7a83..113cb1da2 100644 --- 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 7336b6d5b..6805e4fc3 100644 --- a/src/compiler/ir1util.lisp +++ b/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) diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index bfea7221c..d67fb41b7 100644 --- 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)))) + ;;; 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 eb3e29883..734b44598 100644 --- 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"