src/utilities.lisp (dosequence): Capture SEQ as a variable explicitly.

Previously it used `once-only', but that doesn't actually produce a
binding for constant expressions.

diff --git a/src/utilities.lisp b/src/utilities.lisp
index cb6f0cc..6e7a592 100644 (file)
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -936,8 +936,9 @@
    The loop is surrounded by an anonymous BLOCK and the loop body forms an
    implicit TAGBODY, as is usual.  There is no result-form, however."
 
-  (once-only (:environment env seq start end)
-    (with-gensyms ((ivar "INDEX-") (endvar "END-") (bodyfunc "BODY-"))
+  (once-only (:environment env start end)
+    (with-gensyms ((seqvar "SEQ-") (ivar "INDEX-")
+                  (endvar "END-") (bodyfunc "BODY-"))
       (multiple-value-bind (docs decls body) (parse-body body :docp nil)
        (declare (ignore docs))
 
@@ -946,13 +947,13 @@
                 (let* ((do-vars nil)
                        (end-condition (if endvar
                                           `(>= ,ivar ,endvar)
-                                          `(endp ,seq)))
+                                          `(endp ,seqvar)))
                        (item (if listp
-                                 `(car ,seq)
-                                 `(aref ,seq ,ivar)))
+                                 `(car ,seqvar)
+                                 `(aref ,seqvar ,ivar)))
                        (body-call `(,bodyfunc ,item)))
                   (when listp
-                    (push `(,seq (nthcdr ,start ,seq) (cdr ,seq))
+                    (push `(,seqvar (nthcdr ,start ,seqvar) (cdr ,seqvar))
                           do-vars))
                   (when indexp
                     (push `(,ivar ,start (1+ ,ivar)) do-vars))
@@ -961,17 +962,18 @@
                   `(do ,do-vars (,end-condition) ,body-call))))
 
          `(block nil
-            (flet ((,bodyfunc (,var ,@(and indexvar `(,indexvar)))
-                     ,@decls
-                     (tagbody ,@body)))
-              (etypecase ,seq
-                (vector
-                 (let ((,endvar (or ,end (length ,seq))))
-                   ,(loopguts t nil endvar)))
-                (list
-                 (if ,end
-                     ,(loopguts t t end)
-                     ,(loopguts indexvar t nil)))))))))))
+            (let ((,seqvar ,seq))
+              (flet ((,bodyfunc (,var ,@(and indexvar `(,indexvar)))
+                       ,@decls
+                       (tagbody ,@body)))
+                (etypecase ,seqvar
+                  (vector
+                   (let ((,endvar (or ,end (length ,seqvar))))
+                     ,(loopguts t nil endvar)))
+                  (list
+                   (if ,end
+                       ,(loopguts t t end)
+                       ,(loopguts indexvar t nil))))))))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Structure accessor hacks.