Make sure quantifiers don't cons

[sbcl.git] / src / code / seq.lisp

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 2cd9d52..e6abb66 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -798,24 +798,27 @@ many elements are copied."
 \f
 ;;;; CONCATENATE
 
-(defmacro sb!sequence:dosequence ((e sequence &optional return) &body body)
+(defmacro sb!sequence:dosequence ((element sequence &optional return) &body body)
+  #!+sb-doc
+  "Executes BODY with ELEMENT subsequently bound to each element of
+  SEQUENCE, then returns RETURN."
   (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil)
     (let ((s sequence)
           (sequence (gensym "SEQUENCE")))
       `(block nil
         (let ((,sequence ,s))
           (seq-dispatch ,sequence
-            (dolist (,e ,sequence ,return) ,@body)
-            (do-vector-data (,e ,sequence ,return) ,@body)
+            (dolist (,element ,sequence ,return) ,@body)
+            (do-vector-data (,element ,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)))
                   ((funcall endp ,sequence state limit from-end)
-                   (let ((,e nil))
+                   (let ((,element nil))
                      ,@(filter-dolist-declarations decls)
-                     ,e
+                     ,element
                      ,return))
-                (let ((,e (funcall elt ,sequence state)))
+                (let ((,element (funcall elt ,sequence state)))
                   ,@decls
                   (tagbody
                      ,@forms))))))))))
@@ -1204,17 +1207,20 @@ many elements are copied."
                 ;; from the old seq.lisp into target-seq.lisp.
                 (define-compiler-macro ,name (pred first-seq &rest more-seqs)
                   (let ((elements (make-gensym-list (1+ (length more-seqs))))
-                        (blockname (sb!xc:gensym "BLOCK")))
+                        (blockname (sb!xc:gensym "BLOCK"))
+                        (wrapper (sb!xc:gensym "WRAPPER")))
                     (once-only ((pred pred))
                       `(block ,blockname
-                         (map nil
-                              (lambda (,@elements)
-                                (let ((pred-value (funcall ,pred ,@elements)))
-                                  (,',found-test pred-value
-                                    (return-from ,blockname
-                                      ,',found-result))))
-                              ,first-seq
-                              ,@more-seqs)
+                         (flet ((,wrapper (,@elements)
+                                  (declare (optimize (sb!c::check-tag-existence 0)))
+                                  (let ((pred-value (funcall ,pred ,@elements)))
+                                    (,',found-test pred-value
+                                                   (return-from ,blockname
+                                                     ,',found-result)))))
+                           (declare (inline ,wrapper)
+                                    (dynamic-extent #',wrapper))
+                           (map nil #',wrapper ,first-seq
+                                ,@more-seqs))
                          ,',unfound-result)))))))
   (defquantifier some when pred-value :unfound-result nil :doc
   "Apply PREDICATE to the 0-indexed elements of the sequences, then