0.9.2.43:
[sbcl.git] / src / code / loop.lisp
index 3d9a363..68f1741 100644 (file)
     (&environment env (head-var tail-var &optional user-head-var) form)
   (setq form (sb!xc:macroexpand form env))
   (flet ((cdr-wrap (form n)
-          (declare (fixnum n))
-          (do () ((<= n 4) (setq form `(,(case n
-                                           (1 'cdr)
-                                           (2 'cddr)
-                                           (3 'cdddr)
-                                           (4 'cddddr))
-                                        ,form)))
-            (setq form `(cddddr ,form) n (- n 4)))))
+           (declare (fixnum n))
+           (do () ((<= n 4) (setq form `(,(case n
+                                            (1 'cdr)
+                                            (2 'cddr)
+                                            (3 'cdddr)
+                                            (4 'cddddr))
+                                         ,form)))
+             (setq form `(cddddr ,form) n (- n 4)))))
     (let ((tail-form form) (ncdrs nil))
       ;; Determine whether the form being constructed is a list of known
       ;; length.
       (when (consp form)
-       (cond ((eq (car form) 'list)
-              (setq ncdrs (1- (length (cdr form)))))
-             ((member (car form) '(list* cons))
-              (when (and (cddr form) (member (car (last form)) '(nil 'nil)))
-                (setq ncdrs (- (length (cdr form)) 2))))))
+        (cond ((eq (car form) 'list)
+               (setq ncdrs (1- (length (cdr form)))))
+              ((member (car form) '(list* cons))
+               (when (and (cddr form) (member (car (last form)) '(nil 'nil)))
+                 (setq ncdrs (- (length (cdr form)) 2))))))
       (let ((answer
-             (cond ((null ncdrs)
-                    `(when (setf (cdr ,tail-var) ,tail-form)
-                       (setq ,tail-var (last (cdr ,tail-var)))))
-                   ((< ncdrs 0) (return-from loop-collect-rplacd nil))
-                   ((= ncdrs 0)
-                    ;; @@@@ Here we have a choice of two idioms:
-                    ;;   (RPLACD TAIL (SETQ TAIL TAIL-FORM))
-                    ;;   (SETQ TAIL (SETF (CDR TAIL) TAIL-FORM)).
-                    ;; Genera and most others I have seen do better with the
-                    ;; former.
-                    `(rplacd ,tail-var (setq ,tail-var ,tail-form)))
-                   (t `(setq ,tail-var ,(cdr-wrap `(setf (cdr ,tail-var)
-                                                         ,tail-form)
-                                                  ncdrs))))))
-       ;; If not using locatives or something similar to update the
-       ;; user's head variable, we've got to set it... It's harmless
-       ;; to repeatedly set it unconditionally, and probably faster
-       ;; than checking.
-       (when user-head-var
-         (setq answer
-               `(progn ,answer
-                       (setq ,user-head-var (cdr ,head-var)))))
-       answer))))
+              (cond ((null ncdrs)
+                     `(when (setf (cdr ,tail-var) ,tail-form)
+                        (setq ,tail-var (last (cdr ,tail-var)))))
+                    ((< ncdrs 0) (return-from loop-collect-rplacd nil))
+                    ((= ncdrs 0)
+                     ;; @@@@ Here we have a choice of two idioms:
+                     ;;   (RPLACD TAIL (SETQ TAIL TAIL-FORM))
+                     ;;   (SETQ TAIL (SETF (CDR TAIL) TAIL-FORM)).
+                     ;; Genera and most others I have seen do better with the
+                     ;; former.
+                     `(rplacd ,tail-var (setq ,tail-var ,tail-form)))
+                    (t `(setq ,tail-var ,(cdr-wrap `(setf (cdr ,tail-var)
+                                                          ,tail-form)
+                                                   ncdrs))))))
+        ;; If not using locatives or something similar to update the
+        ;; user's head variable, we've got to set it... It's harmless
+        ;; to repeatedly set it unconditionally, and probably faster
+        ;; than checking.
+        (when user-head-var
+          (setq answer
+                `(progn ,answer
+                        (setq ,user-head-var (cdr ,head-var)))))
+        answer))))
 
 (sb!int:defmacro-mundanely loop-collect-answer (head-var
-                                                  &optional user-head-var)
+                                                   &optional user-head-var)
   (or user-head-var
       `(cdr ,head-var)))
 \f
@@ -169,9 +169,9 @@ constructed.
 |#
 
 (defstruct (loop-minimax
-            (:constructor make-loop-minimax-internal)
-            (:copier nil)
-            (:predicate nil))
+             (:constructor make-loop-minimax-internal)
+             (:copier nil)
+             (:predicate nil))
   answer-variable
   type
   temp-variable
@@ -186,57 +186,57 @@ constructed.
 
 (defun make-loop-minimax (answer-variable type)
   (let ((infinity-data (cdr (assoc type
-                                  *loop-minimax-type-infinities-alist*
-                                  :test #'sb!xc:subtypep))))
+                                   *loop-minimax-type-infinities-alist*
+                                   :test #'sb!xc:subtypep))))
     (make-loop-minimax-internal
       :answer-variable answer-variable
       :type type
       :temp-variable (gensym "LOOP-MAXMIN-TEMP-")
       :flag-variable (and (not infinity-data)
-                         (gensym "LOOP-MAXMIN-FLAG-"))
+                          (gensym "LOOP-MAXMIN-FLAG-"))
       :operations nil
       :infinity-data infinity-data)))
 
 (defun loop-note-minimax-operation (operation minimax)
   (pushnew (the symbol operation) (loop-minimax-operations minimax))
   (when (and (cdr (loop-minimax-operations minimax))
-            (not (loop-minimax-flag-variable minimax)))
+             (not (loop-minimax-flag-variable minimax)))
     (setf (loop-minimax-flag-variable minimax)
-         (gensym "LOOP-MAXMIN-FLAG-")))
+          (gensym "LOOP-MAXMIN-FLAG-")))
   operation)
 
 (sb!int:defmacro-mundanely with-minimax-value (lm &body body)
   (let ((init (loop-typed-init (loop-minimax-type lm)))
-       (which (car (loop-minimax-operations lm)))
-       (infinity-data (loop-minimax-infinity-data lm))
-       (answer-var (loop-minimax-answer-variable lm))
-       (temp-var (loop-minimax-temp-variable lm))
-       (flag-var (loop-minimax-flag-variable lm))
-       (type (loop-minimax-type lm)))
+        (which (car (loop-minimax-operations lm)))
+        (infinity-data (loop-minimax-infinity-data lm))
+        (answer-var (loop-minimax-answer-variable lm))
+        (temp-var (loop-minimax-temp-variable lm))
+        (flag-var (loop-minimax-flag-variable lm))
+        (type (loop-minimax-type lm)))
     (if flag-var
-       `(let ((,answer-var ,init) (,temp-var ,init) (,flag-var nil))
-          (declare (type ,type ,answer-var ,temp-var))
-          ,@body)
-       `(let ((,answer-var ,(if (eq which 'min)
-                                (first infinity-data)
-                                (second infinity-data)))
-              (,temp-var ,init))
-          (declare (type ,type ,answer-var ,temp-var))
-          ,@body))))
+        `(let ((,answer-var ,init) (,temp-var ,init) (,flag-var nil))
+           (declare (type ,type ,answer-var ,temp-var))
+           ,@body)
+        `(let ((,answer-var ,(if (eq which 'min)
+                                 (first infinity-data)
+                                 (second infinity-data)))
+               (,temp-var ,init))
+           (declare (type ,type ,answer-var ,temp-var))
+           ,@body))))
 
 (sb!int:defmacro-mundanely loop-accumulate-minimax-value (lm operation form)
   (let* ((answer-var (loop-minimax-answer-variable lm))
-        (temp-var (loop-minimax-temp-variable lm))
-        (flag-var (loop-minimax-flag-variable lm))
-        (test `(,(ecase operation
-                   (min '<)
-                   (max '>))
-                ,temp-var ,answer-var)))
+         (temp-var (loop-minimax-temp-variable lm))
+         (flag-var (loop-minimax-flag-variable lm))
+         (test `(,(ecase operation
+                    (min '<)
+                    (max '>))
+                 ,temp-var ,answer-var)))
     `(progn
        (setq ,temp-var ,form)
        (when ,(if flag-var `(or (not ,flag-var) ,test) test)
-        (setq ,@(and flag-var `(,flag-var t))
-              ,answer-var ,temp-var)))))
+         (setq ,@(and flag-var `(,flag-var t))
+               ,answer-var ,temp-var)))))
 \f
 ;;;; LOOP keyword tables
 
@@ -273,8 +273,8 @@ code to be loaded.
   `(setf (gethash (symbol-name ,symbol) ,table) ,datum))
 
 (defstruct (loop-universe
-            (:copier nil)
-            (:predicate nil))
+             (:copier nil)
+             (:predicate nil))
   keywords             ; hash table, value = (fn-name . extra-data)
   iteration-keywords   ; hash table, value = (fn-name . extra-data)
   for-keywords         ; hash table, value = (fn-name . extra-data)
@@ -287,10 +287,10 @@ code to be loaded.
   implicit-for-required) ; see loop-hack-iteration
 (sb!int:def!method print-object ((u loop-universe) stream)
   (let ((string (case (loop-universe-ansi u)
-                 ((nil) "non-ANSI")
-                 ((t) "ANSI")
-                 (:extended "extended-ANSI")
-                 (t (loop-universe-ansi u)))))
+                  ((nil) "non-ANSI")
+                  ((t) "ANSI")
+                  (:extended "extended-ANSI")
+                  (t (loop-universe-ansi u)))))
     (print-unreadable-object (u stream :type t)
       (write-string string stream))))
 
@@ -299,16 +299,16 @@ code to be loaded.
 (defvar *loop-universe*)
 
 (defun make-standard-loop-universe (&key keywords for-keywords
-                                        iteration-keywords path-keywords
-                                        type-keywords type-symbols ansi)
+                                         iteration-keywords path-keywords
+                                         type-keywords type-symbols ansi)
   (declare (type (member nil t :extended) ansi))
   (flet ((maketable (entries)
-          (let* ((size (length entries))
-                 (ht (make-hash-table :size (if (< size 10) 10 size)
-                                      :test 'equal)))
-            (dolist (x entries)
-              (setf (gethash (symbol-name (car x)) ht) (cadr x)))
-            ht)))
+           (let* ((size (length entries))
+                  (ht (make-hash-table :size (if (< size 10) 10 size)
+                                       :test 'equal)))
+             (dolist (x entries)
+               (setf (gethash (symbol-name (car x)) ht) (cadr x)))
+             ht)))
     (make-loop-universe
       :keywords (maketable keywords)
       :for-keywords (maketable for-keywords)
@@ -318,23 +318,23 @@ code to be loaded.
       :implicit-for-required (not (null ansi))
       :type-keywords (maketable type-keywords)
       :type-symbols (let* ((size (length type-symbols))
-                          (ht (make-hash-table :size (if (< size 10) 10 size)
-                                               :test 'eq)))
-                     (dolist (x type-symbols)
-                       (if (atom x)
-                           (setf (gethash x ht) x)
-                           (setf (gethash (car x) ht) (cadr x))))
-                     ht))))
+                           (ht (make-hash-table :size (if (< size 10) 10 size)
+                                                :test 'eq)))
+                      (dolist (x type-symbols)
+                        (if (atom x)
+                            (setf (gethash x ht) x)
+                            (setf (gethash (car x) ht) (cadr x))))
+                      ht))))
 \f
 ;;;; SETQ hackery, including destructuring ("DESETQ")
 
 (defun loop-make-psetq (frobs)
   (and frobs
        (loop-make-desetq
-        (list (car frobs)
-              (if (null (cddr frobs)) (cadr frobs)
-                  `(prog1 ,(cadr frobs)
-                          ,(loop-make-psetq (cddr frobs))))))))
+         (list (car frobs)
+               (if (null (cddr frobs)) (cadr frobs)
+                   `(prog1 ,(cadr frobs)
+                           ,(loop-make-psetq (cddr frobs))))))))
 
 (defun loop-make-desetq (var-val-pairs)
   (if (null var-val-pairs)
@@ -342,66 +342,66 @@ code to be loaded.
       (cons 'loop-really-desetq var-val-pairs)))
 
 (defvar *loop-desetq-temporary*
-       (make-symbol "LOOP-DESETQ-TEMP"))
+        (make-symbol "LOOP-DESETQ-TEMP"))
 
 (sb!int:defmacro-mundanely loop-really-desetq (&environment env
-                                              &rest var-val-pairs)
+                                               &rest var-val-pairs)
   (labels ((find-non-null (var)
-            ;; See whether there's any non-null thing here. Recurse
-            ;; if the list element is itself a list.
-            (do ((tail var)) ((not (consp tail)) tail)
-              (when (find-non-null (pop tail)) (return t))))
-          (loop-desetq-internal (var val &optional temp)
-            ;; returns a list of actions to be performed
-            (typecase var
-              (null
-                (when (consp val)
-                  ;; Don't lose possible side effects.
-                  (if (eq (car val) 'prog1)
-                      ;; These can come from PSETQ or DESETQ below.
-                      ;; Throw away the value, keep the side effects.
-                      ;; Special case is for handling an expanded POP.
-                      (mapcan (lambda (x)
-                                (and (consp x)
-                                     (or (not (eq (car x) 'car))
-                                         (not (symbolp (cadr x)))
-                                         (not (symbolp (setq x (sb!xc:macroexpand x env)))))
-                                     (cons x nil)))
-                              (cdr val))
-                      `(,val))))
-              (cons
-                (let* ((car (car var))
-                       (cdr (cdr var))
-                       (car-non-null (find-non-null car))
-                       (cdr-non-null (find-non-null cdr)))
-                  (when (or car-non-null cdr-non-null)
-                    (if cdr-non-null
-                        (let* ((temp-p temp)
-                               (temp (or temp *loop-desetq-temporary*))
-                               (body `(,@(loop-desetq-internal car
-                                                               `(car ,temp))
-                                         (setq ,temp (cdr ,temp))
-                                         ,@(loop-desetq-internal cdr
-                                                                 temp
-                                                                 temp))))
-                          (if temp-p
-                              `(,@(unless (eq temp val)
-                                    `((setq ,temp ,val)))
-                                ,@body)
-                              `((let ((,temp ,val))
-                                  ,@body))))
-                        ;; no CDRing to do
-                        (loop-desetq-internal car `(car ,val) temp)))))
-              (otherwise
-                (unless (eq var val)
-                  `((setq ,var ,val)))))))
+             ;; See whether there's any non-null thing here. Recurse
+             ;; if the list element is itself a list.
+             (do ((tail var)) ((not (consp tail)) tail)
+               (when (find-non-null (pop tail)) (return t))))
+           (loop-desetq-internal (var val &optional temp)
+             ;; returns a list of actions to be performed
+             (typecase var
+               (null
+                 (when (consp val)
+                   ;; Don't lose possible side effects.
+                   (if (eq (car val) 'prog1)
+                       ;; These can come from PSETQ or DESETQ below.
+                       ;; Throw away the value, keep the side effects.
+                       ;; Special case is for handling an expanded POP.
+                       (mapcan (lambda (x)
+                                 (and (consp x)
+                                      (or (not (eq (car x) 'car))
+                                          (not (symbolp (cadr x)))
+                                          (not (symbolp (setq x (sb!xc:macroexpand x env)))))
+                                      (cons x nil)))
+                               (cdr val))
+                       `(,val))))
+               (cons
+                 (let* ((car (car var))
+                        (cdr (cdr var))
+                        (car-non-null (find-non-null car))
+                        (cdr-non-null (find-non-null cdr)))
+                   (when (or car-non-null cdr-non-null)
+                     (if cdr-non-null
+                         (let* ((temp-p temp)
+                                (temp (or temp *loop-desetq-temporary*))
+                                (body `(,@(loop-desetq-internal car
+                                                                `(car ,temp))
+                                          (setq ,temp (cdr ,temp))
+                                          ,@(loop-desetq-internal cdr
+                                                                  temp
+                                                                  temp))))
+                           (if temp-p
+                               `(,@(unless (eq temp val)
+                                     `((setq ,temp ,val)))
+                                 ,@body)
+                               `((let ((,temp ,val))
+                                   ,@body))))
+                         ;; no CDRing to do
+                         (loop-desetq-internal car `(car ,val) temp)))))
+               (otherwise
+                 (unless (eq var val)
+                   `((setq ,var ,val)))))))
     (do ((actions))
-       ((null var-val-pairs)
-        (if (null (cdr actions)) (car actions) `(progn ,@(nreverse actions))))
+        ((null var-val-pairs)
+         (if (null (cdr actions)) (car actions) `(progn ,@(nreverse actions))))
       (setq actions (revappend
-                     (loop-desetq-internal (pop var-val-pairs)
-                                           (pop var-val-pairs))
-                     actions)))))
+                      (loop-desetq-internal (pop var-val-pairs)
+                                            (pop var-val-pairs))
+                      actions)))))
 \f
 ;;;; LOOP-local variables
 
@@ -508,10 +508,10 @@ code to be loaded.
       (setq constant-value (eval new-form)))
     (when (and constantp expected-type)
       (unless (sb!xc:typep constant-value expected-type)
-       (loop-warn "~@<The form ~S evaluated to ~S, which was not of ~
+        (loop-warn "~@<The form ~S evaluated to ~S, which was not of ~
                     the anticipated type ~S.~:@>"
-                  form constant-value expected-type)
-       (setq constantp nil constant-value nil)))
+                   form constant-value expected-type)
+        (setq constantp nil constant-value nil)))
     (values new-form constantp constant-value)))
 
 (defun loop-constantp (form)
@@ -520,58 +520,58 @@ code to be loaded.
 ;;;; LOOP iteration optimization
 
 (defvar *loop-duplicate-code*
-       nil)
+        nil)
 
 (defvar *loop-iteration-flag-var*
-       (make-symbol "LOOP-NOT-FIRST-TIME"))
+        (make-symbol "LOOP-NOT-FIRST-TIME"))
 
 (defun loop-code-duplication-threshold (env)
   (declare (ignore env))
   (let (;; If we could read optimization declaration information (as
-       ;; with the DECLARATION-INFORMATION function (present in
-       ;; CLTL2, removed from ANSI standard) we could set these
-       ;; values flexibly. Without DECLARATION-INFORMATION, we have
-       ;; to set them to constants.
-       ;;
-       ;; except FIXME: we've lost all pretence of portability,
-       ;; considering this instead an internal implementation, so
-       ;; we're free to couple to our own representation of the
-       ;; environment.
-       (speed 1)
-       (space 1))
+        ;; with the DECLARATION-INFORMATION function (present in
+        ;; CLTL2, removed from ANSI standard) we could set these
+        ;; values flexibly. Without DECLARATION-INFORMATION, we have
+        ;; to set them to constants.
+        ;;
+        ;; except FIXME: we've lost all pretence of portability,
+        ;; considering this instead an internal implementation, so
+        ;; we're free to couple to our own representation of the
+        ;; environment.
+        (speed 1)
+        (space 1))
     (+ 40 (* (- speed space) 10))))
 
 (sb!int:defmacro-mundanely loop-body (&environment env
-                                        prologue
-                                        before-loop
-                                        main-body
-                                        after-loop
-                                        epilogue
-                                        &aux rbefore rafter flagvar)
+                                         prologue
+                                         before-loop
+                                         main-body
+                                         after-loop
+                                         epilogue
+                                         &aux rbefore rafter flagvar)
   (unless (= (length before-loop) (length after-loop))
     (error "LOOP-BODY called with non-synched before- and after-loop lists"))
   ;;All our work is done from these copies, working backwards from the end:
   (setq rbefore (reverse before-loop) rafter (reverse after-loop))
   (labels ((psimp (l)
-            (let ((ans nil))
-              (dolist (x l)
-                (when x
-                  (push x ans)
-                  (when (and (consp x)
-                             (member (car x) '(go return return-from)))
-                    (return nil))))
-              (nreverse ans)))
-          (pify (l) (if (null (cdr l)) (car l) `(progn ,@l)))
-          (makebody ()
-            (let ((form `(tagbody
-                           ,@(psimp (append prologue (nreverse rbefore)))
-                        next-loop
-                           ,@(psimp (append main-body
-                                            (nreconc rafter
-                                                     `((go next-loop)))))
-                        end-loop
-                           ,@(psimp epilogue))))
-              (if flagvar `(let ((,flagvar nil)) ,form) form))))
+             (let ((ans nil))
+               (dolist (x l)
+                 (when x
+                   (push x ans)
+                   (when (and (consp x)
+                              (member (car x) '(go return return-from)))
+                     (return nil))))
+               (nreverse ans)))
+           (pify (l) (if (null (cdr l)) (car l) `(progn ,@l)))
+           (makebody ()
+             (let ((form `(tagbody
+                            ,@(psimp (append prologue (nreverse rbefore)))
+                         next-loop
+                            ,@(psimp (append main-body
+                                             (nreconc rafter
+                                                      `((go next-loop)))))
+                         end-loop
+                            ,@(psimp epilogue))))
+               (if flagvar `(let ((,flagvar nil)) ,form) form))))
     (when (or *loop-duplicate-code* (not rbefore))
       (return-from loop-body (makebody)))
     ;; This outer loop iterates once for each not-first-time flag test
@@ -581,8 +581,8 @@ code to be loaded.
       ;; Go backwards from the ends of before-loop and after-loop
       ;; merging all the equivalent forms into the body.
       (do () ((or (null rbefore) (not (equal (car rbefore) (car rafter)))))
-       (push (pop rbefore) main-body)
-       (pop rafter))
+        (push (pop rbefore) main-body)
+        (pop rafter))
       (unless rbefore (return (makebody)))
       ;; The first forms in RBEFORE & RAFTER (which are the
       ;; chronologically last forms in the list) differ, therefore
@@ -597,71 +597,71 @@ code to be loaded.
       ;; chronologically precedes the non-duplicatable form will be
       ;; handled the next time around the outer loop.
       (do ((bb rbefore (cdr bb))
-          (aa rafter (cdr aa))
-          (lastdiff nil)
-          (count 0)
-          (inc nil))
-         ((null bb) (return-from loop-body (makebody)))        ; Did it.
-       (cond ((not (equal (car bb) (car aa))) (setq lastdiff bb count 0))
-             ((or (not (setq inc (estimate-code-size (car bb) env)))
-                  (> (incf count inc) threshold))
-              ;; Ok, we have found a non-duplicatable piece of code.
-              ;; Everything chronologically after it must be in the
-              ;; central body. Everything chronologically at and
-              ;; after LASTDIFF goes into the central body under a
-              ;; flag test.
-              (let ((then nil) (else nil))
-                (do () (nil)
-                  (push (pop rbefore) else)
-                  (push (pop rafter) then)
-                  (when (eq rbefore (cdr lastdiff)) (return)))
-                (unless flagvar
-                  (push `(setq ,(setq flagvar *loop-iteration-flag-var*)
-                               t)
-                        else))
-                (push `(if ,flagvar ,(pify (psimp then)) ,(pify (psimp else)))
-                      main-body))
-              ;; Everything chronologically before lastdiff until the
-              ;; non-duplicatable form (CAR BB) is the same in
-              ;; RBEFORE and RAFTER, so just copy it into the body.
-              (do () (nil)
-                (pop rafter)
-                (push (pop rbefore) main-body)
-                (when (eq rbefore (cdr bb)) (return)))
-              (return)))))))
+           (aa rafter (cdr aa))
+           (lastdiff nil)
+           (count 0)
+           (inc nil))
+          ((null bb) (return-from loop-body (makebody)))        ; Did it.
+        (cond ((not (equal (car bb) (car aa))) (setq lastdiff bb count 0))
+              ((or (not (setq inc (estimate-code-size (car bb) env)))
+                   (> (incf count inc) threshold))
+               ;; Ok, we have found a non-duplicatable piece of code.
+               ;; Everything chronologically after it must be in the
+               ;; central body. Everything chronologically at and
+               ;; after LASTDIFF goes into the central body under a
+               ;; flag test.
+               (let ((then nil) (else nil))
+                 (do () (nil)
+                   (push (pop rbefore) else)
+                   (push (pop rafter) then)
+                   (when (eq rbefore (cdr lastdiff)) (return)))
+                 (unless flagvar
+                   (push `(setq ,(setq flagvar *loop-iteration-flag-var*)
+                                t)
+                         else))
+                 (push `(if ,flagvar ,(pify (psimp then)) ,(pify (psimp else)))
+                       main-body))
+               ;; Everything chronologically before lastdiff until the
+               ;; non-duplicatable form (CAR BB) is the same in
+               ;; RBEFORE and RAFTER, so just copy it into the body.
+               (do () (nil)
+                 (pop rafter)
+                 (push (pop rbefore) main-body)
+                 (when (eq rbefore (cdr bb)) (return)))
+               (return)))))))
 \f
 (defun duplicatable-code-p (expr env)
   (if (null expr) 0
       (let ((ans (estimate-code-size expr env)))
-       (declare (fixnum ans))
-       ;; @@@@ Use (DECLARATION-INFORMATION 'OPTIMIZE ENV) here to
-       ;; get an alist of optimize quantities back to help quantify
-       ;; how much code we are willing to duplicate.
-       ans)))
+        (declare (fixnum ans))
+        ;; @@@@ Use (DECLARATION-INFORMATION 'OPTIMIZE ENV) here to
+        ;; get an alist of optimize quantities back to help quantify
+        ;; how much code we are willing to duplicate.
+        ans)))
 
 (defvar *special-code-sizes*
-       '((return 0) (progn 0)
-         (null 1) (not 1) (eq 1) (car 1) (cdr 1)
-         (when 1) (unless 1) (if 1)
-         (caar 2) (cadr 2) (cdar 2) (cddr 2)
-         (caaar 3) (caadr 3) (cadar 3) (caddr 3)
-         (cdaar 3) (cdadr 3) (cddar 3) (cdddr 3)
-         (caaaar 4) (caaadr 4) (caadar 4) (caaddr 4)
-         (cadaar 4) (cadadr 4) (caddar 4) (cadddr 4)
-         (cdaaar 4) (cdaadr 4) (cdadar 4) (cdaddr 4)
-         (cddaar 4) (cddadr 4) (cdddar 4) (cddddr 4)))
+        '((return 0) (progn 0)
+          (null 1) (not 1) (eq 1) (car 1) (cdr 1)
+          (when 1) (unless 1) (if 1)
+          (caar 2) (cadr 2) (cdar 2) (cddr 2)
+          (caaar 3) (caadr 3) (cadar 3) (caddr 3)
+          (cdaar 3) (cdadr 3) (cddar 3) (cdddr 3)
+          (caaaar 4) (caaadr 4) (caadar 4) (caaddr 4)
+          (cadaar 4) (cadadr 4) (caddar 4) (cadddr 4)
+          (cdaaar 4) (cdaadr 4) (cdadar 4) (cdaddr 4)
+          (cddaar 4) (cddadr 4) (cdddar 4) (cddddr 4)))
 
 (defvar *estimate-code-size-punt*
-       '(block
-          do do* dolist
-          flet
-          labels lambda let let* locally
-          macrolet multiple-value-bind
-          prog prog*
-          symbol-macrolet
-          tagbody
-          unwind-protect
-          with-open-file))
+        '(block
+           do do* dolist
+           flet
+           labels lambda let let* locally
+           macrolet multiple-value-bind
+           prog prog*
+           symbol-macrolet
+           tagbody
+           unwind-protect
+           with-open-file))
 
 (defun destructuring-size (x)
   (do ((x x (cdr x)) (n 0 (+ (destructuring-size (car x)) n)))
@@ -673,63 +673,63 @@ code to be loaded.
 
 (defun estimate-code-size-1 (x env)
   (flet ((list-size (l)
-          (let ((n 0))
-            (declare (fixnum n))
-            (dolist (x l n) (incf n (estimate-code-size-1 x env))))))
+           (let ((n 0))
+             (declare (fixnum n))
+             (dolist (x l n) (incf n (estimate-code-size-1 x env))))))
     ;;@@@@ ???? (declare (function list-size (list) fixnum))
     (cond ((constantp x) 1)
-         ((symbolp x) (multiple-value-bind (new-form expanded-p)
-                          (sb!xc:macroexpand-1 x env)
-                        (if expanded-p
-                            (estimate-code-size-1 new-form env)
-                            1)))
-         ((atom x) 1) ;; ??? self-evaluating???
-         ((symbolp (car x))
-          (let ((fn (car x)) (tem nil) (n 0))
-            (declare (symbol fn) (fixnum n))
-            (macrolet ((f (overhead &optional (args nil args-p))
-                         `(the fixnum (+ (the fixnum ,overhead)
-                                         (the fixnum
-                                              (list-size ,(if args-p
-                                                              args
-                                                            '(cdr x))))))))
-              (cond ((setq tem (get fn 'estimate-code-size))
-                     (typecase tem
-                       (fixnum (f tem))
-                       (t (funcall tem x env))))
-                    ((setq tem (assoc fn *special-code-sizes*))
-                     (f (second tem)))
-                    ((eq fn 'cond)
-                     (dolist (clause (cdr x) n)
-                       (incf n (list-size clause)) (incf n)))
-                    ((eq fn 'desetq)
-                     (do ((l (cdr x) (cdr l))) ((null l) n)
-                       (setq n (+ n
-                                  (destructuring-size (car l))
-                                  (estimate-code-size-1 (cadr l) env)))))
-                    ((member fn '(setq psetq))
-                     (do ((l (cdr x) (cdr l))) ((null l) n)
-                       (setq n (+ n (estimate-code-size-1 (cadr l) env) 1))))
-                    ((eq fn 'go) 1)
-                    ((eq fn 'function)
-                     (if (sb!int:legal-fun-name-p (cadr x))
-                         1
-                         ;; FIXME: This tag appears not to be present
-                         ;; anywhere.
-                         (throw 'duplicatable-code-p nil)))
-                    ((eq fn 'multiple-value-setq)
-                     (f (length (second x)) (cddr x)))
-                    ((eq fn 'return-from)
-                     (1+ (estimate-code-size-1 (third x) env)))
-                    ((or (special-operator-p fn)
-                         (member fn *estimate-code-size-punt*))
-                     (throw 'estimate-code-size nil))
-                    (t (multiple-value-bind (new-form expanded-p)
-                           (sb!xc:macroexpand-1 x env)
-                         (if expanded-p
-                             (estimate-code-size-1 new-form env)
-                             (f 3))))))))
-         (t (throw 'estimate-code-size nil)))))
+          ((symbolp x) (multiple-value-bind (new-form expanded-p)
+                           (sb!xc:macroexpand-1 x env)
+                         (if expanded-p
+                             (estimate-code-size-1 new-form env)
+                             1)))
+          ((atom x) 1) ;; ??? self-evaluating???
+          ((symbolp (car x))
+           (let ((fn (car x)) (tem nil) (n 0))
+             (declare (symbol fn) (fixnum n))
+             (macrolet ((f (overhead &optional (args nil args-p))
+                          `(the fixnum (+ (the fixnum ,overhead)
+                                          (the fixnum
+                                               (list-size ,(if args-p
+                                                               args
+                                                             '(cdr x))))))))
+               (cond ((setq tem (get fn 'estimate-code-size))
+                      (typecase tem
+                        (fixnum (f tem))
+                        (t (funcall tem x env))))
+                     ((setq tem (assoc fn *special-code-sizes*))
+                      (f (second tem)))
+                     ((eq fn 'cond)
+                      (dolist (clause (cdr x) n)
+                        (incf n (list-size clause)) (incf n)))
+                     ((eq fn 'desetq)
+                      (do ((l (cdr x) (cdr l))) ((null l) n)
+                        (setq n (+ n
+                                   (destructuring-size (car l))
+                                   (estimate-code-size-1 (cadr l) env)))))
+                     ((member fn '(setq psetq))
+                      (do ((l (cdr x) (cdr l))) ((null l) n)
+                        (setq n (+ n (estimate-code-size-1 (cadr l) env) 1))))
+                     ((eq fn 'go) 1)
+                     ((eq fn 'function)
+                      (if (sb!int:legal-fun-name-p (cadr x))
+                          1
+                          ;; FIXME: This tag appears not to be present
+                          ;; anywhere.
+                          (throw 'duplicatable-code-p nil)))
+                     ((eq fn 'multiple-value-setq)
+                      (f (length (second x)) (cddr x)))
+                     ((eq fn 'return-from)
+                      (1+ (estimate-code-size-1 (third x) env)))
+                     ((or (special-operator-p fn)
+                          (member fn *estimate-code-size-punt*))
+                      (throw 'estimate-code-size nil))
+                     (t (multiple-value-bind (new-form expanded-p)
+                            (sb!xc:macroexpand-1 x env)
+                          (if expanded-p
+                              (estimate-code-size-1 new-form env)
+                              (f 3))))))))
+          (t (throw 'estimate-code-size nil)))))
 \f
 ;;;; loop errors
 
@@ -739,27 +739,27 @@ code to be loaded.
 
 (defun loop-error (format-string &rest format-args)
   (error 'sb!int:simple-program-error
-        :format-control "~?~%current LOOP context:~{ ~S~}."
-        :format-arguments (list format-string format-args (loop-context))))
+         :format-control "~?~%current LOOP context:~{ ~S~}."
+         :format-arguments (list format-string format-args (loop-context))))
 
 (defun loop-warn (format-string &rest format-args)
   (warn "~?~%current LOOP context:~{ ~S~}."
-       format-string
-       format-args
-       (loop-context)))
+        format-string
+        format-args
+        (loop-context)))
 
 (defun loop-check-data-type (specified-type required-type
-                            &optional (default-type required-type))
+                             &optional (default-type required-type))
   (if (null specified-type)
       default-type
       (multiple-value-bind (a b) (sb!xc:subtypep specified-type required-type)
-       (cond ((not b)
-              (loop-warn "LOOP couldn't verify that ~S is a subtype of the required type ~S."
-                         specified-type required-type))
-             ((not a)
-              (loop-error "The specified data type ~S is not a subtype of ~S."
-                          specified-type required-type)))
-       specified-type)))
+        (cond ((not b)
+               (loop-warn "LOOP couldn't verify that ~S is a subtype of the required type ~S."
+                          specified-type required-type))
+              ((not a)
+               (loop-error "The specified data type ~S is not a subtype of ~S."
+                           specified-type required-type)))
+        specified-type)))
 \f
 (defun subst-gensyms-for-nil (tree)
   (declare (special *ignores*))
@@ -767,16 +767,16 @@ code to be loaded.
     ((null tree) (car (push (gensym "LOOP-IGNORED-VAR-") *ignores*)))
     ((atom tree) tree)
     (t (cons (subst-gensyms-for-nil (car tree))
-            (subst-gensyms-for-nil (cdr tree))))))
-    
+             (subst-gensyms-for-nil (cdr tree))))))
+
 (sb!int:defmacro-mundanely loop-destructuring-bind
     (lambda-list arg-list &rest body)
   (let ((*ignores* nil))
     (declare (special *ignores*))
     (let ((d-var-lambda-list (subst-gensyms-for-nil lambda-list)))
       `(destructuring-bind ,d-var-lambda-list
-          ,arg-list
-        (declare (ignore ,@*ignores*))
+           ,arg-list
+         (declare (ignore ,@*ignores*))
          ,@body))))
 
 (defun loop-build-destructuring-bindings (crocks forms)
@@ -786,85 +786,85 @@ code to be loaded.
       forms))
 
 (defun loop-translate (*loop-source-code*
-                      *loop-macro-environment*
-                      *loop-universe*)
+                       *loop-macro-environment*
+                       *loop-universe*)
   (let ((*loop-original-source-code* *loop-source-code*)
-       (*loop-source-context* nil)
-       (*loop-vars* nil)
-       (*loop-named-vars* nil)
-       (*loop-declarations* nil)
-       (*loop-desetq-crocks* nil)
-       (*loop-bind-stack* nil)
-       (*loop-prologue* nil)
-       (*loop-wrappers* nil)
-       (*loop-before-loop* nil)
-       (*loop-body* nil)
-       (*loop-emitted-body* nil)
-       (*loop-after-body* nil)
-       (*loop-epilogue* nil)
-       (*loop-after-epilogue* nil)
-       (*loop-final-value-culprit* nil)
-       (*loop-inside-conditional* nil)
-       (*loop-when-it-var* nil)
-       (*loop-never-stepped-var* nil)
-       (*loop-names* nil)
-       (*loop-collection-cruft* nil))
+        (*loop-source-context* nil)
+        (*loop-vars* nil)
+        (*loop-named-vars* nil)
+        (*loop-declarations* nil)
+        (*loop-desetq-crocks* nil)
+        (*loop-bind-stack* nil)
+        (*loop-prologue* nil)
+        (*loop-wrappers* nil)
+        (*loop-before-loop* nil)
+        (*loop-body* nil)
+        (*loop-emitted-body* nil)
+        (*loop-after-body* nil)
+        (*loop-epilogue* nil)
+        (*loop-after-epilogue* nil)
+        (*loop-final-value-culprit* nil)
+        (*loop-inside-conditional* nil)
+        (*loop-when-it-var* nil)
+        (*loop-never-stepped-var* nil)
+        (*loop-names* nil)
+        (*loop-collection-cruft* nil))
     (loop-iteration-driver)
     (loop-bind-block)
     (let ((answer `(loop-body
-                    ,(nreverse *loop-prologue*)
-                    ,(nreverse *loop-before-loop*)
-                    ,(nreverse *loop-body*)
-                    ,(nreverse *loop-after-body*)
-                    ,(nreconc *loop-epilogue*
-                              (nreverse *loop-after-epilogue*)))))
+                     ,(nreverse *loop-prologue*)
+                     ,(nreverse *loop-before-loop*)
+                     ,(nreverse *loop-body*)
+                     ,(nreverse *loop-after-body*)
+                     ,(nreconc *loop-epilogue*
+                               (nreverse *loop-after-epilogue*)))))
       (dolist (entry *loop-bind-stack*)
-       (let ((vars (first entry))
-             (dcls (second entry))
-             (crocks (third entry))
-             (wrappers (fourth entry)))
-         (dolist (w wrappers)
-           (setq answer (append w (list answer))))
-         (when (or vars dcls crocks)
-           (let ((forms (list answer)))
-             ;;(when crocks (push crocks forms))
-             (when dcls (push `(declare ,@dcls) forms))
-             (setq answer `(,(if vars 'let 'locally)
-                            ,vars
-                            ,@(loop-build-destructuring-bindings crocks
-                                                                 forms)))))))
+        (let ((vars (first entry))
+              (dcls (second entry))
+              (crocks (third entry))
+              (wrappers (fourth entry)))
+          (dolist (w wrappers)
+            (setq answer (append w (list answer))))
+          (when (or vars dcls crocks)
+            (let ((forms (list answer)))
+              ;;(when crocks (push crocks forms))
+              (when dcls (push `(declare ,@dcls) forms))
+              (setq answer `(,(if vars 'let 'locally)
+                             ,vars
+                             ,@(loop-build-destructuring-bindings crocks
+                                                                  forms)))))))
       (do () (nil)
-       (setq answer `(block ,(pop *loop-names*) ,answer))
-       (unless *loop-names* (return nil)))
+        (setq answer `(block ,(pop *loop-names*) ,answer))
+        (unless *loop-names* (return nil)))
       answer)))
 
 (defun loop-iteration-driver ()
-  (do () 
+  (do ()
       ((null *loop-source-code*))
     (let ((keyword (car *loop-source-code*)) (tem nil))
       (cond ((not (symbolp keyword))
-            (loop-error "~S found where LOOP keyword expected" keyword))
-           (t (setq *loop-source-context* *loop-source-code*)
-              (loop-pop-source)
-              (cond ((setq tem
-                           (loop-lookup-keyword keyword
-                                                (loop-universe-keywords
-                                                 *loop-universe*)))
-                     ;; It's a "miscellaneous" toplevel LOOP keyword (DO,
-                     ;; COLLECT, NAMED, etc.)
-                     (apply (symbol-function (first tem)) (rest tem)))
-                    ((setq tem
-                           (loop-lookup-keyword keyword
-                                                (loop-universe-iteration-keywords *loop-universe*)))
-                     (loop-hack-iteration tem))
-                    ((loop-tmember keyword '(and else))
-                     ;; The alternative is to ignore it, i.e. let it go
-                     ;; around to the next keyword...
-                     (loop-error "secondary clause misplaced at top level in LOOP macro: ~S ~S ~S ..."
-                                 keyword
-                                 (car *loop-source-code*)
-                                 (cadr *loop-source-code*)))
-                    (t (loop-error "unknown LOOP keyword: ~S" keyword))))))))
+             (loop-error "~S found where LOOP keyword expected" keyword))
+            (t (setq *loop-source-context* *loop-source-code*)
+               (loop-pop-source)
+               (cond ((setq tem
+                            (loop-lookup-keyword keyword
+                                                 (loop-universe-keywords
+                                                  *loop-universe*)))
+                      ;; It's a "miscellaneous" toplevel LOOP keyword (DO,
+                      ;; COLLECT, NAMED, etc.)
+                      (apply (symbol-function (first tem)) (rest tem)))
+                     ((setq tem
+                            (loop-lookup-keyword keyword
+                                                 (loop-universe-iteration-keywords *loop-universe*)))
+                      (loop-hack-iteration tem))
+                     ((loop-tmember keyword '(and else))
+                      ;; The alternative is to ignore it, i.e. let it go
+                      ;; around to the next keyword...
+                      (loop-error "secondary clause misplaced at top level in LOOP macro: ~S ~S ~S ..."
+                                  keyword
+                                  (car *loop-source-code*)
+                                  (cadr *loop-source-code*)))
+                     (t (loop-error "unknown LOOP keyword: ~S" keyword))))))))
 \f
 (defun loop-pop-source ()
   (if *loop-source-code*
@@ -895,8 +895,8 @@ code to be loaded.
 
 (defun loop-pseudo-body (form)
   (cond ((or *loop-emitted-body* *loop-inside-conditional*)
-        (push form *loop-body*))
-       (t (push form *loop-before-loop*) (push form *loop-after-body*))))
+         (push form *loop-body*))
+        (t (push form *loop-before-loop*) (push form *loop-after-body*))))
 
 (defun loop-emit-body (form)
   (setq *loop-emitted-body* t)
@@ -924,91 +924,91 @@ code to be loaded.
 (defun loop-typed-init (data-type &optional step-var-p)
   (when (and data-type (sb!xc:subtypep data-type 'number))
     (if (or (sb!xc:subtypep data-type 'float)
-           (sb!xc:subtypep data-type '(complex float)))
-       (coerce (if step-var-p 1 0) data-type)
-       (if step-var-p 1 0))))
+            (sb!xc:subtypep data-type '(complex float)))
+        (coerce (if step-var-p 1 0) data-type)
+        (if step-var-p 1 0))))
 
 (defun loop-optional-type (&optional variable)
   ;; No variable specified implies that no destructuring is permissible.
   (and *loop-source-code* ; Don't get confused by NILs..
        (let ((z (car *loop-source-code*)))
-        (cond ((loop-tequal z 'of-type)
-               ;; This is the syntactically unambigous form in that
-               ;; the form of the type specifier does not matter.
-               ;; Also, it is assumed that the type specifier is
-               ;; unambiguously, and without need of translation, a
-               ;; common lisp type specifier or pattern (matching the
-               ;; variable) thereof.
-               (loop-pop-source)
-               (loop-pop-source))
-
-              ((symbolp z)
-               ;; This is the (sort of) "old" syntax, even though we
-               ;; didn't used to support all of these type symbols.
-               (let ((type-spec (or (gethash z
-                                             (loop-universe-type-symbols
-                                              *loop-universe*))
-                                    (gethash (symbol-name z)
-                                             (loop-universe-type-keywords
-                                              *loop-universe*)))))
-                 (when type-spec
-                   (loop-pop-source)
-                   type-spec)))
-              (t
-               ;; This is our sort-of old syntax. But this is only
-               ;; valid for when we are destructuring, so we will be
-               ;; compulsive (should we really be?) and require that
-               ;; we in fact be doing variable destructuring here. We
-               ;; must translate the old keyword pattern typespec
-               ;; into a fully-specified pattern of real type
-               ;; specifiers here.
-               (if (consp variable)
-                   (unless (consp z)
-                    (loop-error
-                       "~S found where a LOOP keyword, LOOP type keyword, or LOOP type pattern expected"
-                       z))
-                   (loop-error "~S found where a LOOP keyword or LOOP type keyword expected" z))
-               (loop-pop-source)
-               (labels ((translate (k v)
-                          (cond ((null k) nil)
-                                ((atom k)
-                                 (replicate
-                                   (or (gethash k
-                                                (loop-universe-type-symbols
-                                                 *loop-universe*))
-                                       (gethash (symbol-name k)
-                                                (loop-universe-type-keywords
-                                                 *loop-universe*))
-                                       (loop-error
-                                         "The destructuring type pattern ~S contains the unrecognized type keyword ~S."
-                                         z k))
-                                   v))
-                                ((atom v)
-                                 (loop-error
-                                   "The destructuring type pattern ~S doesn't match the variable pattern ~S."
-                                   z variable))
-                                (t (cons (translate (car k) (car v))
-                                         (translate (cdr k) (cdr v))))))
-                        (replicate (typ v)
-                          (if (atom v)
-                              typ
-                              (cons (replicate typ (car v))
-                                    (replicate typ (cdr v))))))
-                 (translate z variable)))))))
+         (cond ((loop-tequal z 'of-type)
+                ;; This is the syntactically unambigous form in that
+                ;; the form of the type specifier does not matter.
+                ;; Also, it is assumed that the type specifier is
+                ;; unambiguously, and without need of translation, a
+                ;; common lisp type specifier or pattern (matching the
+                ;; variable) thereof.
+                (loop-pop-source)
+                (loop-pop-source))
+
+               ((symbolp z)
+                ;; This is the (sort of) "old" syntax, even though we
+                ;; didn't used to support all of these type symbols.
+                (let ((type-spec (or (gethash z
+                                              (loop-universe-type-symbols
+                                               *loop-universe*))
+                                     (gethash (symbol-name z)
+                                              (loop-universe-type-keywords
+                                               *loop-universe*)))))
+                  (when type-spec
+                    (loop-pop-source)
+                    type-spec)))
+               (t
+                ;; This is our sort-of old syntax. But this is only
+                ;; valid for when we are destructuring, so we will be
+                ;; compulsive (should we really be?) and require that
+                ;; we in fact be doing variable destructuring here. We
+                ;; must translate the old keyword pattern typespec
+                ;; into a fully-specified pattern of real type
+                ;; specifiers here.
+                (if (consp variable)
+                    (unless (consp z)
+                     (loop-error
+                        "~S found where a LOOP keyword, LOOP type keyword, or LOOP type pattern expected"
+                        z))
+                    (loop-error "~S found where a LOOP keyword or LOOP type keyword expected" z))
+                (loop-pop-source)
+                (labels ((translate (k v)
+                           (cond ((null k) nil)
+                                 ((atom k)
+                                  (replicate
+                                    (or (gethash k
+                                                 (loop-universe-type-symbols
+                                                  *loop-universe*))
+                                        (gethash (symbol-name k)
+                                                 (loop-universe-type-keywords
+                                                  *loop-universe*))
+                                        (loop-error
+                                          "The destructuring type pattern ~S contains the unrecognized type keyword ~S."
+                                          z k))
+                                    v))
+                                 ((atom v)
+                                  (loop-error
+                                    "The destructuring type pattern ~S doesn't match the variable pattern ~S."
+                                    z variable))
+                                 (t (cons (translate (car k) (car v))
+                                          (translate (cdr k) (cdr v))))))
+                         (replicate (typ v)
+                           (if (atom v)
+                               typ
+                               (cons (replicate typ (car v))
+                                     (replicate typ (cdr v))))))
+                  (translate z variable)))))))
 \f
 ;;;; loop variables
 
 (defun loop-bind-block ()
   (when (or *loop-vars* *loop-declarations* *loop-wrappers*)
     (push (list (nreverse *loop-vars*)
-               *loop-declarations*
-               *loop-desetq-crocks*
-               *loop-wrappers*)
-         *loop-bind-stack*)
+                *loop-declarations*
+                *loop-desetq-crocks*
+                *loop-wrappers*)
+          *loop-bind-stack*)
     (setq *loop-vars* nil
-         *loop-declarations* nil
-         *loop-desetq-crocks* nil
-         *loop-wrappers* nil)))
+          *loop-declarations* nil
+          *loop-desetq-crocks* nil
+          *loop-wrappers* nil)))
 
 (defun loop-var-p (name)
   (do ((entry *loop-bind-stack* (cdr entry)))
@@ -1019,52 +1019,52 @@ code to be loaded.
 
 (defun loop-make-var (name initialization dtype &optional step-var-p)
   (cond ((null name)
-        (setq name (gensym "LOOP-IGNORE-"))
-        (push (list name initialization) *loop-vars*)
-        (if (null initialization)
-            (push `(ignore ,name) *loop-declarations*)
-            (loop-declare-var name dtype)))
-       ((atom name)
+         (setq name (gensym "LOOP-IGNORE-"))
+         (push (list name initialization) *loop-vars*)
+         (if (null initialization)
+             (push `(ignore ,name) *loop-declarations*)
+             (loop-declare-var name dtype)))
+        ((atom name)
          (when (or (assoc name *loop-vars*)
                    (loop-var-p name))
            (loop-error "duplicated variable ~S in a LOOP binding" name))
-        (unless (symbolp name)
-          (loop-error "bad variable ~S somewhere in LOOP" name))
-        (loop-declare-var name dtype step-var-p)
-        ;; We use ASSOC on this list to check for duplications (above),
-        ;; so don't optimize out this list:
-        (push (list name (or initialization (loop-typed-init dtype step-var-p)))
-              *loop-vars*))
-       (initialization
-        (let ((newvar (gensym "LOOP-DESTRUCTURE-")))
+         (unless (symbolp name)
+           (loop-error "bad variable ~S somewhere in LOOP" name))
+         (loop-declare-var name dtype step-var-p)
+         ;; We use ASSOC on this list to check for duplications (above),
+         ;; so don't optimize out this list:
+         (push (list name (or initialization (loop-typed-init dtype step-var-p)))
+               *loop-vars*))
+        (initialization
+         (let ((newvar (gensym "LOOP-DESTRUCTURE-")))
            (loop-declare-var name dtype)
            (push (list newvar initialization) *loop-vars*)
            ;; *LOOP-DESETQ-CROCKS* gathered in reverse order.
            (setq *loop-desetq-crocks*
                  (list* name newvar *loop-desetq-crocks*))))
-       (t (let ((tcar nil) (tcdr nil))
-            (if (atom dtype) (setq tcar (setq tcdr dtype))
-                (setq tcar (car dtype) tcdr (cdr dtype)))
-            (loop-make-var (car name) nil tcar)
-            (loop-make-var (cdr name) nil tcdr))))
+        (t (let ((tcar nil) (tcdr nil))
+             (if (atom dtype) (setq tcar (setq tcdr dtype))
+                 (setq tcar (car dtype) tcdr (cdr dtype)))
+             (loop-make-var (car name) nil tcar)
+             (loop-make-var (cdr name) nil tcdr))))
   name)
 
 (defun loop-declare-var (name dtype &optional step-var-p)
   (cond ((or (null name) (null dtype) (eq dtype t)) nil)
-       ((symbolp name)
-        (unless (sb!xc:subtypep t dtype)
-          (let ((dtype (let ((init (loop-typed-init dtype step-var-p)))
-                         (if (sb!xc:typep init dtype)
-                             dtype
-                             `(or (member ,init) ,dtype)))))
-            (push `(type ,dtype ,name) *loop-declarations*))))
-       ((consp name)
-        (cond ((consp dtype)
-               (loop-declare-var (car name) (car dtype))
-               (loop-declare-var (cdr name) (cdr dtype)))
-              (t (loop-declare-var (car name) dtype)
-                 (loop-declare-var (cdr name) dtype))))
-       (t (error "invalid LOOP variable passed in: ~S" name))))
+        ((symbolp name)
+         (unless (sb!xc:subtypep t dtype)
+           (let ((dtype (let ((init (loop-typed-init dtype step-var-p)))
+                          (if (sb!xc:typep init dtype)
+                              dtype
+                              `(or (member ,init) ,dtype)))))
+             (push `(type ,dtype ,name) *loop-declarations*))))
+        ((consp name)
+         (cond ((consp dtype)
+                (loop-declare-var (car name) (car dtype))
+                (loop-declare-var (cdr name) (cdr dtype)))
+               (t (loop-declare-var (car name) dtype)
+                  (loop-declare-var (cdr name) dtype))))
+        (t (error "invalid LOOP variable passed in: ~S" name))))
 
 (defun loop-maybe-bind-form (form data-type)
   (if (loop-constantp form)
@@ -1073,51 +1073,51 @@ code to be loaded.
 \f
 (defun loop-do-if (for negatep)
   (let ((form (loop-get-form))
-       (*loop-inside-conditional* t)
-       (it-p nil)
-       (first-clause-p t))
+        (*loop-inside-conditional* t)
+        (it-p nil)
+        (first-clause-p t))
     (flet ((get-clause (for)
-            (do ((body nil)) (nil)
-              (let ((key (car *loop-source-code*)) (*loop-body* nil) data)
-                (cond ((not (symbolp key))
-                       (loop-error
-                         "~S found where keyword expected getting LOOP clause after ~S"
-                         key for))
-                      (t (setq *loop-source-context* *loop-source-code*)
-                         (loop-pop-source)
-                         (when (and (loop-tequal (car *loop-source-code*) 'it)
-                                    first-clause-p)
-                           (setq *loop-source-code*
-                                 (cons (or it-p
-                                           (setq it-p
-                                                 (loop-when-it-var)))
-                                       (cdr *loop-source-code*))))
-                         (cond ((or (not (setq data (loop-lookup-keyword
-                                                      key (loop-universe-keywords *loop-universe*))))
-                                    (progn (apply (symbol-function (car data))
-                                                  (cdr data))
-                                           (null *loop-body*)))
-                                (loop-error
-                                  "~S does not introduce a LOOP clause that can follow ~S."
-                                  key for))
-                               (t (setq body (nreconc *loop-body* body)))))))
-              (setq first-clause-p nil)
-              (if (loop-tequal (car *loop-source-code*) :and)
-                  (loop-pop-source)
-                  (return (if (cdr body)
-                              `(progn ,@(nreverse body))
-                              (car body)))))))
+             (do ((body nil)) (nil)
+               (let ((key (car *loop-source-code*)) (*loop-body* nil) data)
+                 (cond ((not (symbolp key))
+                        (loop-error
+                          "~S found where keyword expected getting LOOP clause after ~S"
+                          key for))
+                       (t (setq *loop-source-context* *loop-source-code*)
+                          (loop-pop-source)
+                          (when (and (loop-tequal (car *loop-source-code*) 'it)
+                                     first-clause-p)
+                            (setq *loop-source-code*
+                                  (cons (or it-p
+                                            (setq it-p
+                                                  (loop-when-it-var)))
+                                        (cdr *loop-source-code*))))
+                          (cond ((or (not (setq data (loop-lookup-keyword
+                                                       key (loop-universe-keywords *loop-universe*))))
+                                     (progn (apply (symbol-function (car data))
+                                                   (cdr data))
+                                            (null *loop-body*)))
+                                 (loop-error
+                                   "~S does not introduce a LOOP clause that can follow ~S."
+                                   key for))
+                                (t (setq body (nreconc *loop-body* body)))))))
+               (setq first-clause-p nil)
+               (if (loop-tequal (car *loop-source-code*) :and)
+                   (loop-pop-source)
+                   (return (if (cdr body)
+                               `(progn ,@(nreverse body))
+                               (car body)))))))
       (let ((then (get-clause for))
-           (else (when (loop-tequal (car *loop-source-code*) :else)
-                   (loop-pop-source)
-                   (list (get-clause :else)))))
-       (when (loop-tequal (car *loop-source-code*) :end)
-         (loop-pop-source))
-       (when it-p (setq form `(setq ,it-p ,form)))
-       (loop-pseudo-body
-         `(if ,(if negatep `(not ,form) form)
-              ,then
-              ,@else))))))
+            (else (when (loop-tequal (car *loop-source-code*) :else)
+                    (loop-pop-source)
+                    (list (get-clause :else)))))
+        (when (loop-tequal (car *loop-source-code*) :end)
+          (loop-pop-source))
+        (when it-p (setq form `(setq ,it-p ,form)))
+        (loop-pseudo-body
+          `(if ,(if negatep `(not ,form) form)
+               ,then
+               ,@else))))))
 
 (defun loop-do-initially ()
   (loop-disallow-conditional :initially)
@@ -1138,7 +1138,7 @@ code to be loaded.
       (loop-error "The NAMED ~S clause occurs too late." name))
     (when *loop-names*
       (loop-error "You may only use one NAMED clause in your loop: NAMED ~S ... NAMED ~S."
-                 (car *loop-names*) name))
+                  (car *loop-names*) name))
     (setq *loop-names* (list name))))
 
 (defun loop-do-return ()
@@ -1147,8 +1147,8 @@ code to be loaded.
 ;;;; value accumulation: LIST
 
 (defstruct (loop-collector
-           (:copier nil)
-           (:predicate nil))
+            (:copier nil)
+            (:predicate nil))
   name
   class
   (history nil)
@@ -1158,10 +1158,10 @@ code to be loaded.
 
 (defun loop-get-collection-info (collector class default-type)
   (let ((form (loop-get-form))
-       (dtype (and (not (loop-universe-ansi *loop-universe*)) (loop-optional-type)))
-       (name (when (loop-tequal (car *loop-source-code*) 'into)
-               (loop-pop-source)
-               (loop-pop-source))))
+        (dtype (and (not (loop-universe-ansi *loop-universe*)) (loop-optional-type)))
+        (name (when (loop-tequal (car *loop-source-code*) 'into)
+                (loop-pop-source)
+                (loop-pop-source))))
     (when (not (symbolp name))
       (loop-error "The value accumulation recipient name, ~S, is not a symbol." name))
     (unless name
@@ -1169,48 +1169,48 @@ code to be loaded.
     (unless dtype
       (setq dtype (or (loop-optional-type) default-type)))
     (let ((cruft (find (the symbol name) *loop-collection-cruft*
-                      :key #'loop-collector-name)))
+                       :key #'loop-collector-name)))
       (cond ((not cruft)
-            (when (and name (loop-var-p name))
-              (loop-error "Variable ~S in INTO clause is a duplicate" name))
-            (push (setq cruft (make-loop-collector
-                                :name name :class class
-                                :history (list collector) :dtype dtype))
-                  *loop-collection-cruft*))
-           (t (unless (eq (loop-collector-class cruft) class)
-                (loop-error
-                  "incompatible kinds of LOOP value accumulation specified for collecting~@
+             (when (and name (loop-var-p name))
+               (loop-error "Variable ~S in INTO clause is a duplicate" name))
+             (push (setq cruft (make-loop-collector
+                                 :name name :class class
+                                 :history (list collector) :dtype dtype))
+                   *loop-collection-cruft*))
+            (t (unless (eq (loop-collector-class cruft) class)
+                 (loop-error
+                   "incompatible kinds of LOOP value accumulation specified for collecting~@
                     ~:[as the value of the LOOP~;~:*INTO ~S~]: ~S and ~S"
-                  name (car (loop-collector-history cruft)) collector))
-              (unless (equal dtype (loop-collector-dtype cruft))
-                (loop-warn
-                  "unequal datatypes specified in different LOOP value accumulations~@
+                   name (car (loop-collector-history cruft)) collector))
+               (unless (equal dtype (loop-collector-dtype cruft))
+                 (loop-warn
+                   "unequal datatypes specified in different LOOP value accumulations~@
                    into ~S: ~S and ~S"
-                  name dtype (loop-collector-dtype cruft))
-                (when (eq (loop-collector-dtype cruft) t)
-                  (setf (loop-collector-dtype cruft) dtype)))
-              (push collector (loop-collector-history cruft))))
+                   name dtype (loop-collector-dtype cruft))
+                 (when (eq (loop-collector-dtype cruft) t)
+                   (setf (loop-collector-dtype cruft) dtype)))
+               (push collector (loop-collector-history cruft))))
       (values cruft form))))
 
-(defun loop-list-collection (specifically)     ; NCONC, LIST, or APPEND
+(defun loop-list-collection (specifically)      ; NCONC, LIST, or APPEND
   (multiple-value-bind (lc form)
       (loop-get-collection-info specifically 'list 'list)
     (let ((tempvars (loop-collector-tempvars lc)))
       (unless tempvars
-       (setf (loop-collector-tempvars lc)
-             (setq tempvars (list* (gensym "LOOP-LIST-HEAD-")
-                                   (gensym "LOOP-LIST-TAIL-")
-                                   (and (loop-collector-name lc)
-                                        (list (loop-collector-name lc))))))
-       (push `(with-loop-list-collection-head ,tempvars) *loop-wrappers*)
-       (unless (loop-collector-name lc)
-         (loop-emit-final-value `(loop-collect-answer ,(car tempvars)
-                                                      ,@(cddr tempvars)))))
+        (setf (loop-collector-tempvars lc)
+              (setq tempvars (list* (gensym "LOOP-LIST-HEAD-")
+                                    (gensym "LOOP-LIST-TAIL-")
+                                    (and (loop-collector-name lc)
+                                         (list (loop-collector-name lc))))))
+        (push `(with-loop-list-collection-head ,tempvars) *loop-wrappers*)
+        (unless (loop-collector-name lc)
+          (loop-emit-final-value `(loop-collect-answer ,(car tempvars)
+                                                       ,@(cddr tempvars)))))
       (ecase specifically
-       (list (setq form `(list ,form)))
-       (nconc nil)
-       (append (unless (and (consp form) (eq (car form) 'list))
-                 (setq form `(copy-list ,form)))))
+        (list (setq form `(list ,form)))
+        (nconc nil)
+        (append (unless (and (consp form) (eq (car form) 'list))
+                  (setq form `(copy-list ,form)))))
       (loop-emit-body `(loop-collect-rplacd ,tempvars ,form)))))
 \f
 ;;;; value accumulation: MAX, MIN, SUM, COUNT
@@ -1221,21 +1221,21 @@ code to be loaded.
     (loop-check-data-type (loop-collector-dtype lc) required-type)
     (let ((tempvars (loop-collector-tempvars lc)))
       (unless tempvars
-       (setf (loop-collector-tempvars lc)
-             (setq tempvars (list (loop-make-var
-                                    (or (loop-collector-name lc)
-                                        (gensym "LOOP-SUM-"))
-                                    nil (loop-collector-dtype lc)))))
-       (unless (loop-collector-name lc)
-         (loop-emit-final-value (car (loop-collector-tempvars lc)))))
+        (setf (loop-collector-tempvars lc)
+              (setq tempvars (list (loop-make-var
+                                     (or (loop-collector-name lc)
+                                         (gensym "LOOP-SUM-"))
+                                     nil (loop-collector-dtype lc)))))
+        (unless (loop-collector-name lc)
+          (loop-emit-final-value (car (loop-collector-tempvars lc)))))
       (loop-emit-body
-       (if (eq specifically 'count)
-           `(when ,form
-              (setq ,(car tempvars)
-                    (1+ ,(car tempvars))))
-           `(setq ,(car tempvars)
-                  (+ ,(car tempvars)
-                     ,form)))))))
+        (if (eq specifically 'count)
+            `(when ,form
+               (setq ,(car tempvars)
+                     (1+ ,(car tempvars))))
+            `(setq ,(car tempvars)
+                   (+ ,(car tempvars)
+                      ,form)))))))
 
 (defun loop-maxmin-collection (specifically)
   (multiple-value-bind (lc form)
@@ -1243,18 +1243,18 @@ code to be loaded.
     (loop-check-data-type (loop-collector-dtype lc) 'real)
     (let ((data (loop-collector-data lc)))
       (unless data
-       (setf (loop-collector-data lc)
-             (setq data (make-loop-minimax
-                          (or (loop-collector-name lc)
-                              (gensym "LOOP-MAXMIN-"))
-                          (loop-collector-dtype lc))))
-       (unless (loop-collector-name lc)
-         (loop-emit-final-value (loop-minimax-answer-variable data))))
+        (setf (loop-collector-data lc)
+              (setq data (make-loop-minimax
+                           (or (loop-collector-name lc)
+                               (gensym "LOOP-MAXMIN-"))
+                           (loop-collector-dtype lc))))
+        (unless (loop-collector-name lc)
+          (loop-emit-final-value (loop-minimax-answer-variable data))))
       (loop-note-minimax-operation specifically data)
       (push `(with-minimax-value ,data) *loop-wrappers*)
       (loop-emit-body `(loop-accumulate-minimax-value ,data
-                                                     ,specifically
-                                                     ,form)))))
+                                                      ,specifically
+                                                      ,form)))))
 \f
 ;;;; value accumulation: aggregate booleans
 
@@ -1266,7 +1266,7 @@ code to be loaded.
     (when restrictive (loop-disallow-conditional))
     (loop-disallow-anonymous-collectors)
     (loop-emit-body `(,(if negate 'when 'unless) ,form
-                     ,(loop-construct-return nil)))
+                      ,(loop-construct-return nil)))
     (loop-emit-final-value t)))
 
 ;;; handling the THEREIS loop keyword
@@ -1277,7 +1277,7 @@ code to be loaded.
   (loop-disallow-anonymous-collectors)
   (loop-emit-final-value)
   (loop-emit-body `(when (setq ,(loop-when-it-var) ,(loop-get-form))
-                   ,(loop-construct-return *loop-when-it-var*))))
+                    ,(loop-construct-return *loop-when-it-var*))))
 \f
 (defun loop-do-while (negate kwd &aux (form (loop-get-form)))
   (loop-disallow-conditional kwd)
@@ -1286,7 +1286,7 @@ code to be loaded.
 (defun loop-do-repeat ()
   (loop-disallow-conditional :repeat)
   (let ((form (loop-get-form))
-       (type 'integer))
+        (type 'integer))
     (let ((var (loop-make-var (gensym "LOOP-REPEAT-") `(ceiling ,form) type)))
       (push `(if (<= ,var 0) (go end-loop) (decf ,var)) *loop-before-loop*)
       (push `(if (<= ,var 0) (go end-loop) (decf ,var)) *loop-after-body*)
@@ -1301,112 +1301,112 @@ code to be loaded.
 
 (defun loop-do-with ()
   (loop-disallow-conditional :with)
-  (do ((var) (val) (dtype)) 
+  (do ((var) (val) (dtype))
       (nil)
     (setq var (loop-pop-source)
-         dtype (loop-optional-type var)
-         val (cond ((loop-tequal (car *loop-source-code*) :=)
-                    (loop-pop-source)
-                    (loop-get-form))
-                   (t nil)))
+          dtype (loop-optional-type var)
+          val (cond ((loop-tequal (car *loop-source-code*) :=)
+                     (loop-pop-source)
+                     (loop-get-form))
+                    (t nil)))
     (when (and var (loop-var-p var))
       (loop-error "Variable ~S has already been used" var))
     (loop-make-var var val dtype)
     (if (loop-tequal (car *loop-source-code*) :and)
-       (loop-pop-source)
-       (return (loop-bind-block)))))
+        (loop-pop-source)
+        (return (loop-bind-block)))))
 \f
 ;;;; the iteration driver
 
 (defun loop-hack-iteration (entry)
   (flet ((make-endtest (list-of-forms)
-          (cond ((null list-of-forms) nil)
-                ((member t list-of-forms) '(go end-loop))
-                (t `(when ,(if (null (cdr (setq list-of-forms
-                                                (nreverse list-of-forms))))
-                               (car list-of-forms)
-                               (cons 'or list-of-forms))
-                      (go end-loop))))))
+           (cond ((null list-of-forms) nil)
+                 ((member t list-of-forms) '(go end-loop))
+                 (t `(when ,(if (null (cdr (setq list-of-forms
+                                                 (nreverse list-of-forms))))
+                                (car list-of-forms)
+                                (cons 'or list-of-forms))
+                       (go end-loop))))))
     (do ((pre-step-tests nil)
-        (steps nil)
-        (post-step-tests nil)
-        (pseudo-steps nil)
-        (pre-loop-pre-step-tests nil)
-        (pre-loop-steps nil)
-        (pre-loop-post-step-tests nil)
-        (pre-loop-pseudo-steps nil)
-        (tem) (data))
-       (nil)
+         (steps nil)
+         (post-step-tests nil)
+         (pseudo-steps nil)
+         (pre-loop-pre-step-tests nil)
+         (pre-loop-steps nil)
+         (pre-loop-post-step-tests nil)
+         (pre-loop-pseudo-steps nil)
+         (tem) (data))
+        (nil)
       ;; Note that we collect endtests in reverse order, but steps in correct
       ;; order. MAKE-ENDTEST does the nreverse for us.
       (setq tem (setq data
-                     (apply (symbol-function (first entry)) (rest entry))))
+                      (apply (symbol-function (first entry)) (rest entry))))
       (and (car tem) (push (car tem) pre-step-tests))
       (setq steps (nconc steps (copy-list (car (setq tem (cdr tem))))))
       (and (car (setq tem (cdr tem))) (push (car tem) post-step-tests))
       (setq pseudo-steps
-           (nconc pseudo-steps (copy-list (car (setq tem (cdr tem))))))
+            (nconc pseudo-steps (copy-list (car (setq tem (cdr tem))))))
       (setq tem (cdr tem))
       (when *loop-emitted-body*
-       (loop-error "iteration in LOOP follows body code"))
+        (loop-error "iteration in LOOP follows body code"))
       (unless tem (setq tem data))
       (when (car tem) (push (car tem) pre-loop-pre-step-tests))
       ;; FIXME: This (SETF FOO (NCONC FOO BAR)) idiom appears often enough
       ;; that it might be worth making it into an NCONCF macro.
       (setq pre-loop-steps
-           (nconc pre-loop-steps (copy-list (car (setq tem (cdr tem))))))
+            (nconc pre-loop-steps (copy-list (car (setq tem (cdr tem))))))
       (when (car (setq tem (cdr tem)))
-       (push (car tem) pre-loop-post-step-tests))
+        (push (car tem) pre-loop-post-step-tests))
       (setq pre-loop-pseudo-steps
-           (nconc pre-loop-pseudo-steps (copy-list (cadr tem))))
+            (nconc pre-loop-pseudo-steps (copy-list (cadr tem))))
       (unless (loop-tequal (car *loop-source-code*) :and)
-       (setq *loop-before-loop*
-             (list* (loop-make-desetq pre-loop-pseudo-steps)
-                    (make-endtest pre-loop-post-step-tests)
-                    (loop-make-psetq pre-loop-steps)
-                    (make-endtest pre-loop-pre-step-tests)
-                    *loop-before-loop*))
-       (setq *loop-after-body*
-             (list* (loop-make-desetq pseudo-steps)
-                    (make-endtest post-step-tests)
-                    (loop-make-psetq steps)
-                    (make-endtest pre-step-tests)
-                    *loop-after-body*))
-       (loop-bind-block)
-       (return nil))
-      (loop-pop-source)                                ; Flush the "AND".
+        (setq *loop-before-loop*
+              (list* (loop-make-desetq pre-loop-pseudo-steps)
+                     (make-endtest pre-loop-post-step-tests)
+                     (loop-make-psetq pre-loop-steps)
+                     (make-endtest pre-loop-pre-step-tests)
+                     *loop-before-loop*))
+        (setq *loop-after-body*
+              (list* (loop-make-desetq pseudo-steps)
+                     (make-endtest post-step-tests)
+                     (loop-make-psetq steps)
+                     (make-endtest pre-step-tests)
+                     *loop-after-body*))
+        (loop-bind-block)
+        (return nil))
+      (loop-pop-source)                         ; Flush the "AND".
       (when (and (not (loop-universe-implicit-for-required *loop-universe*))
-                (setq tem
-                      (loop-lookup-keyword
-                       (car *loop-source-code*)
-                       (loop-universe-iteration-keywords *loop-universe*))))
-       ;; The latest ANSI clarification is that the FOR/AS after the AND must
-       ;; NOT be supplied.
-       (loop-pop-source)
-       (setq entry tem)))))
+                 (setq tem
+                       (loop-lookup-keyword
+                        (car *loop-source-code*)
+                        (loop-universe-iteration-keywords *loop-universe*))))
+        ;; The latest ANSI clarification is that the FOR/AS after the AND must
+        ;; NOT be supplied.
+        (loop-pop-source)
+        (setq entry tem)))))
 \f
 ;;;; main iteration drivers
 
 ;;; FOR variable keyword ..args..
 (defun loop-do-for ()
   (let* ((var (loop-pop-source))
-        (data-type (loop-optional-type var))
-        (keyword (loop-pop-source))
-        (first-arg nil)
-        (tem nil))
+         (data-type (loop-optional-type var))
+         (keyword (loop-pop-source))
+         (first-arg nil)
+         (tem nil))
     (setq first-arg (loop-get-form))
     (unless (and (symbolp keyword)
-                (setq tem (loop-lookup-keyword
-                            keyword
-                            (loop-universe-for-keywords *loop-universe*))))
+                 (setq tem (loop-lookup-keyword
+                             keyword
+                             (loop-universe-for-keywords *loop-universe*))))
       (loop-error "~S is an unknown keyword in FOR or AS clause in LOOP."
-                 keyword))
+                  keyword))
     (apply (car tem) var first-arg data-type (cdr tem))))
 
 (defun loop-when-it-var ()
   (or *loop-when-it-var*
       (setq *loop-when-it-var*
-           (loop-make-var (gensym "LOOP-IT-") nil nil))))
+            (loop-make-var (gensym "LOOP-IT-") nil nil))))
 \f
 ;;;; various FOR/AS subdispatches
 
@@ -1418,44 +1418,44 @@ code to be loaded.
 (defun loop-ansi-for-equals (var val data-type)
   (loop-make-var var nil data-type)
   (cond ((loop-tequal (car *loop-source-code*) :then)
-        ;; Then we are the same as "FOR x FIRST y THEN z".
-        (loop-pop-source)
-        `(() (,var ,(loop-get-form)) () ()
-          () (,var ,val) () ()))
-       (t ;; We are the same as "FOR x = y".
-        `(() (,var ,val) () ()))))
+         ;; Then we are the same as "FOR x FIRST y THEN z".
+         (loop-pop-source)
+         `(() (,var ,(loop-get-form)) () ()
+           () (,var ,val) () ()))
+        (t ;; We are the same as "FOR x = y".
+         `(() (,var ,val) () ()))))
 
 (defun loop-for-across (var val data-type)
   (loop-make-var var nil data-type)
   (let ((vector-var (gensym "LOOP-ACROSS-VECTOR-"))
-       (index-var (gensym "LOOP-ACROSS-INDEX-")))
+        (index-var (gensym "LOOP-ACROSS-INDEX-")))
     (multiple-value-bind (vector-form constantp vector-value)
-       (loop-constant-fold-if-possible val 'vector)
+        (loop-constant-fold-if-possible val 'vector)
       (loop-make-var
-       vector-var vector-form
-       (if (and (consp vector-form) (eq (car vector-form) 'the))
-           (cadr vector-form)
-           'vector))
+        vector-var vector-form
+        (if (and (consp vector-form) (eq (car vector-form) 'the))
+            (cadr vector-form)
+            'vector))
       (loop-make-var index-var 0 'fixnum)
       (let* ((length 0)
-            (length-form (cond ((not constantp)
-                                (let ((v (gensym "LOOP-ACROSS-LIMIT-")))
-                                  (push `(setq ,v (length ,vector-var))
-                                        *loop-prologue*)
-                                  (loop-make-var v 0 'fixnum)))
-                               (t (setq length (length vector-value)))))
-            (first-test `(>= ,index-var ,length-form))
-            (other-test first-test)
-            (step `(,var (aref ,vector-var ,index-var)))
-            (pstep `(,index-var (1+ ,index-var))))
-       (declare (fixnum length))
-       (when constantp
-         (setq first-test (= length 0))
-         (when (<= length 1)
-           (setq other-test t)))
-       `(,other-test ,step () ,pstep
-         ,@(and (not (eq first-test other-test))
-                `(,first-test ,step () ,pstep)))))))
+             (length-form (cond ((not constantp)
+                                 (let ((v (gensym "LOOP-ACROSS-LIMIT-")))
+                                   (push `(setq ,v (length ,vector-var))
+                                         *loop-prologue*)
+                                   (loop-make-var v 0 'fixnum)))
+                                (t (setq length (length vector-value)))))
+             (first-test `(>= ,index-var ,length-form))
+             (other-test first-test)
+             (step `(,var (aref ,vector-var ,index-var)))
+             (pstep `(,index-var (1+ ,index-var))))
+        (declare (fixnum length))
+        (when constantp
+          (setq first-test (= length 0))
+          (when (<= length 1)
+            (setq other-test t)))
+        `(,other-test ,step () ,pstep
+          ,@(and (not (eq first-test other-test))
+                 `(,first-test ,step () ,pstep)))))))
 \f
 ;;;; list iteration
 
@@ -1468,46 +1468,46 @@ code to be loaded.
   ;; (FUNCALL 'FOO ...), not recognizing FOO may defeat some LOOP
   ;; optimizations.
   (let ((stepper (cond ((loop-tequal (car *loop-source-code*) :by)
-                       (loop-pop-source)
-                       (loop-get-form))
-                      (t '(function cdr)))))
+                        (loop-pop-source)
+                        (loop-get-form))
+                       (t '(function cdr)))))
     (cond ((and (consp stepper) (eq (car stepper) 'quote))
-          (loop-warn "Use of QUOTE around stepping function in LOOP will be left verbatim.")
-          `(funcall ,stepper ,listvar))
-         ((and (consp stepper) (eq (car stepper) 'function))
-          (list (cadr stepper) listvar))
-         (t
-          `(funcall ,(loop-make-var (gensym "LOOP-FN-") stepper 'function)
-                    ,listvar)))))
+           (loop-warn "Use of QUOTE around stepping function in LOOP will be left verbatim.")
+           `(funcall ,stepper ,listvar))
+          ((and (consp stepper) (eq (car stepper) 'function))
+           (list (cadr stepper) listvar))
+          (t
+           `(funcall ,(loop-make-var (gensym "LOOP-FN-") stepper 'function)
+                     ,listvar)))))
 
 (defun loop-for-on (var val data-type)
   (multiple-value-bind (list constantp list-value)
       (loop-constant-fold-if-possible val)
     (let ((listvar var))
       (cond ((and var (symbolp var))
-            (loop-make-var var list data-type))
-           (t 
+             (loop-make-var var list data-type))
+            (t
              (loop-make-var (setq listvar (gensym)) list 't)
              (loop-make-var var nil data-type)))
       (let ((list-step (loop-list-step listvar)))
-       (let* ((first-endtest
-               ;; mysterious comment from original CMU CL sources:
-               ;;   the following should use `atom' instead of `endp',
-               ;;   per [bug2428]
-               `(atom ,listvar))
-              (other-endtest first-endtest))
-         (when (and constantp (listp list-value))
-           (setq first-endtest (null list-value)))
-         (cond ((eq var listvar)
-                ;; The contour of the loop is different because we
-                ;; use the user's variable...
-                `(() (,listvar ,list-step)
-                  ,other-endtest () () () ,first-endtest ()))
-               (t (let ((step `(,var ,listvar))
-                        (pseudo `(,listvar ,list-step)))
-                    `(,other-endtest ,step () ,pseudo
-                      ,@(and (not (eq first-endtest other-endtest))
-                             `(,first-endtest ,step () ,pseudo)))))))))))
+        (let* ((first-endtest
+                ;; mysterious comment from original CMU CL sources:
+                ;;   the following should use `atom' instead of `endp',
+                ;;   per [bug2428]
+                `(atom ,listvar))
+               (other-endtest first-endtest))
+          (when (and constantp (listp list-value))
+            (setq first-endtest (null list-value)))
+          (cond ((eq var listvar)
+                 ;; The contour of the loop is different because we
+                 ;; use the user's variable...
+                 `(() (,listvar ,list-step)
+                   ,other-endtest () () () ,first-endtest ()))
+                (t (let ((step `(,var ,listvar))
+                         (pseudo `(,listvar ,list-step)))
+                     `(,other-endtest ,step () ,pseudo
+                       ,@(and (not (eq first-endtest other-endtest))
+                              `(,first-endtest ,step () ,pseudo)))))))))))
 
 (defun loop-for-in (var val data-type)
   (multiple-value-bind (list constantp list-value)
@@ -1516,21 +1516,21 @@ code to be loaded.
       (loop-make-var var nil data-type)
       (loop-make-var listvar list 'list)
       (let ((list-step (loop-list-step listvar)))
-       (let* ((first-endtest `(endp ,listvar))
-              (other-endtest first-endtest)
-              (step `(,var (car ,listvar)))
-              (pseudo-step `(,listvar ,list-step)))
-         (when (and constantp (listp list-value))
-           (setq first-endtest (null list-value)))
-         `(,other-endtest ,step () ,pseudo-step
-           ,@(and (not (eq first-endtest other-endtest))
-                  `(,first-endtest ,step () ,pseudo-step))))))))
+        (let* ((first-endtest `(endp ,listvar))
+               (other-endtest first-endtest)
+               (step `(,var (car ,listvar)))
+               (pseudo-step `(,listvar ,list-step)))
+          (when (and constantp (listp list-value))
+            (setq first-endtest (null list-value)))
+          `(,other-endtest ,step () ,pseudo-step
+            ,@(and (not (eq first-endtest other-endtest))
+                   `(,first-endtest ,step () ,pseudo-step))))))))
 \f
 ;;;; iteration paths
 
 (defstruct (loop-path
-           (:copier nil)
-           (:predicate nil))
+            (:copier nil)
+            (:predicate nil))
   names
   preposition-groups
   inclusive-permitted
@@ -1538,19 +1538,19 @@ code to be loaded.
   user-data)
 
 (defun add-loop-path (names function universe
-                     &key preposition-groups inclusive-permitted user-data)
+                      &key preposition-groups inclusive-permitted user-data)
   (declare (type loop-universe universe))
   (unless (listp names)
     (setq names (list names)))
   (let ((ht (loop-universe-path-keywords universe))
-       (lp (make-loop-path
-             :names (mapcar #'symbol-name names)
-             :function function
-             :user-data user-data
-             :preposition-groups (mapcar (lambda (x)
-                                           (if (listp x) x (list x)))
-                                         preposition-groups)
-             :inclusive-permitted inclusive-permitted)))
+        (lp (make-loop-path
+              :names (mapcar #'symbol-name names)
+              :function function
+              :user-data user-data
+              :preposition-groups (mapcar (lambda (x)
+                                            (if (listp x) x (list x)))
+                                          preposition-groups)
+              :inclusive-permitted inclusive-permitted)))
     (dolist (name names)
       (setf (gethash (symbol-name name) ht) lp))
     lp))
@@ -1561,51 +1561,51 @@ code to be loaded.
   ;; FOR var BEING each/the pathname prep-phrases using-stuff... each/the =
   ;; EACH or THE. Not clear if it is optional, so I guess we'll warn.
   (let ((path nil)
-       (data nil)
-       (inclusive nil)
-       (stuff nil)
-       (initial-prepositions nil))
+        (data nil)
+        (inclusive nil)
+        (stuff nil)
+        (initial-prepositions nil))
     (cond ((loop-tmember val '(:each :the)) (setq path (loop-pop-source)))
-         ((loop-tequal (car *loop-source-code*) :and)
-          (loop-pop-source)
-          (setq inclusive t)
-          (unless (loop-tmember (car *loop-source-code*)
-                                '(:its :each :his :her))
-            (loop-error "~S was found where ITS or EACH expected in LOOP iteration path syntax."
-                        (car *loop-source-code*)))
-          (loop-pop-source)
-          (setq path (loop-pop-source))
-          (setq initial-prepositions `((:in ,val))))
-         (t (loop-error "unrecognizable LOOP iteration path syntax: missing EACH or THE?")))
+          ((loop-tequal (car *loop-source-code*) :and)
+           (loop-pop-source)
+           (setq inclusive t)
+           (unless (loop-tmember (car *loop-source-code*)
+                                 '(:its :each :his :her))
+             (loop-error "~S was found where ITS or EACH expected in LOOP iteration path syntax."
+                         (car *loop-source-code*)))
+           (loop-pop-source)
+           (setq path (loop-pop-source))
+           (setq initial-prepositions `((:in ,val))))
+          (t (loop-error "unrecognizable LOOP iteration path syntax: missing EACH or THE?")))
     (cond ((not (symbolp path))
-          (loop-error
-           "~S was found where a LOOP iteration path name was expected."
-           path))
-         ((not (setq data (loop-lookup-keyword path (loop-universe-path-keywords *loop-universe*))))
-          (loop-error "~S is not the name of a LOOP iteration path." path))
-         ((and inclusive (not (loop-path-inclusive-permitted data)))
-          (loop-error "\"Inclusive\" iteration is not possible with the ~S LOOP iteration path." path)))
+           (loop-error
+            "~S was found where a LOOP iteration path name was expected."
+            path))
+          ((not (setq data (loop-lookup-keyword path (loop-universe-path-keywords *loop-universe*))))
+           (loop-error "~S is not the name of a LOOP iteration path." path))
+          ((and inclusive (not (loop-path-inclusive-permitted data)))
+           (loop-error "\"Inclusive\" iteration is not possible with the ~S LOOP iteration path." path)))
     (let ((fun (loop-path-function data))
-         (preps (nconc initial-prepositions
-                       (loop-collect-prepositional-phrases
-                        (loop-path-preposition-groups data)
-                        t)))
-         (user-data (loop-path-user-data data)))
+          (preps (nconc initial-prepositions
+                        (loop-collect-prepositional-phrases
+                         (loop-path-preposition-groups data)
+                         t)))
+          (user-data (loop-path-user-data data)))
       (when (symbolp fun) (setq fun (symbol-function fun)))
       (setq stuff (if inclusive
-                     (apply fun var data-type preps :inclusive t user-data)
-                     (apply fun var data-type preps user-data))))
+                      (apply fun var data-type preps :inclusive t user-data)
+                      (apply fun var data-type preps user-data))))
     (when *loop-named-vars*
       (loop-error "Unused USING vars: ~S." *loop-named-vars*))
     ;; STUFF is now (bindings prologue-forms . stuff-to-pass-back).
     ;; Protect the system from the user and the user from himself.
     (unless (member (length stuff) '(6 10))
       (loop-error "Value passed back by LOOP iteration path function for path ~S has invalid length."
-                 path))
+                  path))
     (do ((l (car stuff) (cdr l)) (x)) ((null l))
       (if (atom (setq x (car l)))
-         (loop-make-var x nil nil)
-         (loop-make-var (car x) (cadr x) (caddr x))))
+          (loop-make-var x nil nil)
+          (loop-make-var (car x) (cadr x) (caddr x))))
     (setq *loop-prologue* (nconc (reverse (cadr stuff)) *loop-prologue*))
     (cddr stuff)))
 \f
@@ -1613,197 +1613,197 @@ code to be loaded.
   (let ((tem (loop-tassoc name *loop-named-vars*)))
     (declare (list tem))
     (cond ((null tem) (values (gensym) nil))
-         (t (setq *loop-named-vars* (delete tem *loop-named-vars*))
-            (values (cdr tem) t)))))
+          (t (setq *loop-named-vars* (delete tem *loop-named-vars*))
+             (values (cdr tem) t)))))
 
 (defun loop-collect-prepositional-phrases (preposition-groups
-                                          &optional
-                                          using-allowed
-                                          initial-phrases)
+                                           &optional
+                                           using-allowed
+                                           initial-phrases)
   (flet ((in-group-p (x group) (car (loop-tmember x group))))
     (do ((token nil)
-        (prepositional-phrases initial-phrases)
-        (this-group nil nil)
-        (this-prep nil nil)
-        (disallowed-prepositions
-          (mapcan (lambda (x)
-                    (copy-list
-                     (find (car x) preposition-groups :test #'in-group-p)))
-                  initial-phrases))
-        (used-prepositions (mapcar #'car initial-phrases)))
-       ((null *loop-source-code*) (nreverse prepositional-phrases))
+         (prepositional-phrases initial-phrases)
+         (this-group nil nil)
+         (this-prep nil nil)
+         (disallowed-prepositions
+           (mapcan (lambda (x)
+                     (copy-list
+                      (find (car x) preposition-groups :test #'in-group-p)))
+                   initial-phrases))
+         (used-prepositions (mapcar #'car initial-phrases)))
+        ((null *loop-source-code*) (nreverse prepositional-phrases))
       (declare (symbol this-prep))
       (setq token (car *loop-source-code*))
       (dolist (group preposition-groups)
-       (when (setq this-prep (in-group-p token group))
-         (return (setq this-group group))))
+        (when (setq this-prep (in-group-p token group))
+          (return (setq this-group group))))
       (cond (this-group
-            (when (member this-prep disallowed-prepositions)
-              (loop-error
-                (if (member this-prep used-prepositions)
-                    "A ~S prepositional phrase occurs multiply for some LOOP clause."
-                    "Preposition ~S was used when some other preposition has subsumed it.")
-                token))
-            (setq used-prepositions (if (listp this-group)
-                                        (append this-group used-prepositions)
-                                        (cons this-group used-prepositions)))
-            (loop-pop-source)
-            (push (list this-prep (loop-get-form)) prepositional-phrases))
-           ((and using-allowed (loop-tequal token 'using))
-            (loop-pop-source)
-            (do ((z (loop-pop-source) (loop-pop-source)) (tem)) (nil)
-              (when (cadr z)
-                (if (setq tem (loop-tassoc (car z) *loop-named-vars*))
-                    (loop-error
-                      "The variable substitution for ~S occurs twice in a USING phrase,~@
+             (when (member this-prep disallowed-prepositions)
+               (loop-error
+                 (if (member this-prep used-prepositions)
+                     "A ~S prepositional phrase occurs multiply for some LOOP clause."
+                     "Preposition ~S was used when some other preposition has subsumed it.")
+                 token))
+             (setq used-prepositions (if (listp this-group)
+                                         (append this-group used-prepositions)
+                                         (cons this-group used-prepositions)))
+             (loop-pop-source)
+             (push (list this-prep (loop-get-form)) prepositional-phrases))
+            ((and using-allowed (loop-tequal token 'using))
+             (loop-pop-source)
+             (do ((z (loop-pop-source) (loop-pop-source)) (tem)) (nil)
+               (when (cadr z)
+                 (if (setq tem (loop-tassoc (car z) *loop-named-vars*))
+                     (loop-error
+                       "The variable substitution for ~S occurs twice in a USING phrase,~@
                         with ~S and ~S."
-                      (car z) (cadr z) (cadr tem))
-                    (push (cons (car z) (cadr z)) *loop-named-vars*)))
-              (when (or (null *loop-source-code*)
-                        (symbolp (car *loop-source-code*)))
-                (return nil))))
-           (t (return (nreverse prepositional-phrases)))))))
+                       (car z) (cadr z) (cadr tem))
+                     (push (cons (car z) (cadr z)) *loop-named-vars*)))
+               (when (or (null *loop-source-code*)
+                         (symbolp (car *loop-source-code*)))
+                 (return nil))))
+            (t (return (nreverse prepositional-phrases)))))))
 \f
 ;;;; master sequencer function
 
-(defun loop-sequencer (indexv indexv-type 
-                      variable variable-type
-                      sequence-variable sequence-type
-                      step-hack default-top
-                      prep-phrases)
+(defun loop-sequencer (indexv indexv-type
+                       variable variable-type
+                       sequence-variable sequence-type
+                       step-hack default-top
+                       prep-phrases)
    (let ((endform nil) ; form (constant or variable) with limit value
-        (sequencep nil) ; T if sequence arg has been provided
-        (testfn nil) ; endtest function
-        (test nil) ; endtest form
-        (stepby (1+ (or (loop-typed-init indexv-type) 0))) ; our increment
-        (stepby-constantp t)
-        (step nil) ; step form
-        (dir nil) ; direction of stepping: NIL, :UP, :DOWN
-        (inclusive-iteration nil) ; T if include last index
-        (start-given nil) ; T when prep phrase has specified start
-        (start-value nil)
-        (start-constantp nil)
-        (limit-given nil) ; T when prep phrase has specified end
-        (limit-constantp nil)
-        (limit-value nil)
-        )
+         (sequencep nil) ; T if sequence arg has been provided
+         (testfn nil) ; endtest function
+         (test nil) ; endtest form
+         (stepby (1+ (or (loop-typed-init indexv-type) 0))) ; our increment
+         (stepby-constantp t)
+         (step nil) ; step form
+         (dir nil) ; direction of stepping: NIL, :UP, :DOWN
+         (inclusive-iteration nil) ; T if include last index
+         (start-given nil) ; T when prep phrase has specified start
+         (start-value nil)
+         (start-constantp nil)
+         (limit-given nil) ; T when prep phrase has specified end
+         (limit-constantp nil)
+         (limit-value nil)
+         )
      (flet ((assert-index-for-arithmetic (index)
-             (unless (atom index)
-               (loop-error "Arithmetic index must be an atom."))))
+              (unless (atom index)
+                (loop-error "Arithmetic index must be an atom."))))
        (when variable (loop-make-var variable nil variable-type))
        (do ((l prep-phrases (cdr l)) (prep) (form) (odir)) ((null l))
-        (setq prep (caar l) form (cadar l))
-        (case prep
-          ((:of :in)
-           (setq sequencep t)
-           (loop-make-var sequence-variable form sequence-type))
-          ((:from :downfrom :upfrom)
-           (setq start-given t)
-           (cond ((eq prep :downfrom) (setq dir ':down))
-                 ((eq prep :upfrom) (setq dir ':up)))
-           (multiple-value-setq (form start-constantp start-value)
-             (loop-constant-fold-if-possible form indexv-type))
-           (assert-index-for-arithmetic indexv)
-           ;; KLUDGE: loop-make-var generates a temporary symbol for
-           ;; indexv if it is NIL. We have to use it to have the index
-           ;; actually count
-           (setq indexv (loop-make-var indexv form indexv-type)))
-          ((:upto :to :downto :above :below)
-           (cond ((loop-tequal prep :upto) (setq inclusive-iteration
-                                                 (setq dir ':up)))
-                 ((loop-tequal prep :to) (setq inclusive-iteration t))
-                 ((loop-tequal prep :downto) (setq inclusive-iteration
-                                                   (setq dir ':down)))
-                 ((loop-tequal prep :above) (setq dir ':down))
-                 ((loop-tequal prep :below) (setq dir ':up)))
-           (setq limit-given t)
-           (multiple-value-setq (form limit-constantp limit-value)
-             (loop-constant-fold-if-possible form `(and ,indexv-type real)))
-           (setq endform (if limit-constantp
-                             `',limit-value
-                             (loop-make-var
-                                (gensym "LOOP-LIMIT-") form
-                                `(and ,indexv-type real)))))
-          (:by
-           (multiple-value-setq (form stepby-constantp stepby)
-             (loop-constant-fold-if-possible form `(and ,indexv-type (real (0)))))
-           (unless stepby-constantp
-             (loop-make-var (setq stepby (gensym "LOOP-STEP-BY-"))
-                form
-                `(and ,indexv-type (real (0)))
-                t)))
-          (t (loop-error
-                "~S invalid preposition in sequencing or sequence path;~@
+         (setq prep (caar l) form (cadar l))
+         (case prep
+           ((:of :in)
+            (setq sequencep t)
+            (loop-make-var sequence-variable form sequence-type))
+           ((:from :downfrom :upfrom)
+            (setq start-given t)
+            (cond ((eq prep :downfrom) (setq dir ':down))
+                  ((eq prep :upfrom) (setq dir ':up)))
+            (multiple-value-setq (form start-constantp start-value)
+              (loop-constant-fold-if-possible form indexv-type))
+            (assert-index-for-arithmetic indexv)
+            ;; KLUDGE: loop-make-var generates a temporary symbol for
+            ;; indexv if it is NIL. We have to use it to have the index
+            ;; actually count
+            (setq indexv (loop-make-var indexv form indexv-type)))
+           ((:upto :to :downto :above :below)
+            (cond ((loop-tequal prep :upto) (setq inclusive-iteration
+                                                  (setq dir ':up)))
+                  ((loop-tequal prep :to) (setq inclusive-iteration t))
+                  ((loop-tequal prep :downto) (setq inclusive-iteration
+                                                    (setq dir ':down)))
+                  ((loop-tequal prep :above) (setq dir ':down))
+                  ((loop-tequal prep :below) (setq dir ':up)))
+            (setq limit-given t)
+            (multiple-value-setq (form limit-constantp limit-value)
+              (loop-constant-fold-if-possible form `(and ,indexv-type real)))
+            (setq endform (if limit-constantp
+                              `',limit-value
+                              (loop-make-var
+                                 (gensym "LOOP-LIMIT-") form
+                                 `(and ,indexv-type real)))))
+           (:by
+            (multiple-value-setq (form stepby-constantp stepby)
+              (loop-constant-fold-if-possible form `(and ,indexv-type (real (0)))))
+            (unless stepby-constantp
+              (loop-make-var (setq stepby (gensym "LOOP-STEP-BY-"))
+                 form
+                 `(and ,indexv-type (real (0)))
+                 t)))
+           (t (loop-error
+                 "~S invalid preposition in sequencing or sequence path;~@
               maybe invalid prepositions were specified in iteration path descriptor?"
-                prep)))
-        (when (and odir dir (not (eq dir odir)))
-          (loop-error "conflicting stepping directions in LOOP sequencing path"))
-        (setq odir dir))
+                 prep)))
+         (when (and odir dir (not (eq dir odir)))
+           (loop-error "conflicting stepping directions in LOOP sequencing path"))
+         (setq odir dir))
        (when (and sequence-variable (not sequencep))
-        (loop-error "missing OF or IN phrase in sequence path"))
+         (loop-error "missing OF or IN phrase in sequence path"))
        ;; Now fill in the defaults.
        (if start-given
-          (when limit-given
-            ;; if both start and limit are given, they had better both
-            ;; be REAL.  We already enforce the REALness of LIMIT,
-            ;; above; here's the KLUDGE to enforce the type of START.
-            (flet ((type-declaration-of (x)
-                     (and (eq (car x) 'type) (caddr x))))
-              (let ((decl (find indexv *loop-declarations*
-                                :key #'type-declaration-of))
-                    (%decl (find indexv *loop-declarations*
-                                 :key #'type-declaration-of
-                                 :from-end t)))
-                (sb!int:aver (eq decl %decl))
-                (setf (cadr decl)
-                      `(and real ,(cadr decl))))))
-          ;; default start
-          ;; DUPLICATE KLUDGE: loop-make-var generates a temporary
-          ;; symbol for indexv if it is NIL. See also the comment in
-          ;; the (:from :downfrom :upfrom) case
-          (progn
-            (assert-index-for-arithmetic indexv)
-            (setq indexv
-                  (loop-make-var
-                     indexv
-                     (setq start-constantp t
-                           start-value (or (loop-typed-init indexv-type) 0))
-                     `(and ,indexv-type real)))))
+           (when limit-given
+             ;; if both start and limit are given, they had better both
+             ;; be REAL.  We already enforce the REALness of LIMIT,
+             ;; above; here's the KLUDGE to enforce the type of START.
+             (flet ((type-declaration-of (x)
+                      (and (eq (car x) 'type) (caddr x))))
+               (let ((decl (find indexv *loop-declarations*
+                                 :key #'type-declaration-of))
+                     (%decl (find indexv *loop-declarations*
+                                  :key #'type-declaration-of
+                                  :from-end t)))
+                 (sb!int:aver (eq decl %decl))
+                 (setf (cadr decl)
+                       `(and real ,(cadr decl))))))
+           ;; default start
+           ;; DUPLICATE KLUDGE: loop-make-var generates a temporary
+           ;; symbol for indexv if it is NIL. See also the comment in
+           ;; the (:from :downfrom :upfrom) case
+           (progn
+             (assert-index-for-arithmetic indexv)
+             (setq indexv
+                   (loop-make-var
+                      indexv
+                      (setq start-constantp t
+                            start-value (or (loop-typed-init indexv-type) 0))
+                      `(and ,indexv-type real)))))
        (cond ((member dir '(nil :up))
-             (when (or limit-given default-top)
-               (unless limit-given
-                 (loop-make-var (setq endform (gensym "LOOP-SEQ-LIMIT-"))
-                    nil
-                    indexv-type)
-                 (push `(setq ,endform ,default-top) *loop-prologue*))
-               (setq testfn (if inclusive-iteration '> '>=)))
-             (setq step (if (eql stepby 1) `(1+ ,indexv) `(+ ,indexv ,stepby))))
-            (t (unless start-given
-                 (unless default-top
-                   (loop-error "don't know where to start stepping"))
-                 (push `(setq ,indexv (1- ,default-top)) *loop-prologue*))
-               (when (and default-top (not endform))
-                 (setq endform (loop-typed-init indexv-type)
-                       inclusive-iteration t))
-               (when endform (setq testfn (if inclusive-iteration  '< '<=)))
-               (setq step
-                     (if (eql stepby 1) `(1- ,indexv) `(- ,indexv ,stepby)))))
+              (when (or limit-given default-top)
+                (unless limit-given
+                  (loop-make-var (setq endform (gensym "LOOP-SEQ-LIMIT-"))
+                     nil
+                     indexv-type)
+                  (push `(setq ,endform ,default-top) *loop-prologue*))
+                (setq testfn (if inclusive-iteration '> '>=)))
+              (setq step (if (eql stepby 1) `(1+ ,indexv) `(+ ,indexv ,stepby))))
+             (t (unless start-given
+                  (unless default-top
+                    (loop-error "don't know where to start stepping"))
+                  (push `(setq ,indexv (1- ,default-top)) *loop-prologue*))
+                (when (and default-top (not endform))
+                  (setq endform (loop-typed-init indexv-type)
+                        inclusive-iteration t))
+                (when endform (setq testfn (if inclusive-iteration  '< '<=)))
+                (setq step
+                      (if (eql stepby 1) `(1- ,indexv) `(- ,indexv ,stepby)))))
        (when testfn
-        (setq test
-              `(,testfn ,indexv ,endform)))
+         (setq test
+               `(,testfn ,indexv ,endform)))
        (when step-hack
-        (setq step-hack
-              `(,variable ,step-hack)))
+         (setq step-hack
+               `(,variable ,step-hack)))
        (let ((first-test test) (remaining-tests test))
-        (when (and stepby-constantp start-constantp limit-constantp
-                   (realp start-value) (realp limit-value))
-          (when (setq first-test
-                      (funcall (symbol-function testfn)
-                               start-value
-                               limit-value))
-            (setq remaining-tests t)))
-        `(() (,indexv ,step)
-          ,remaining-tests ,step-hack () () ,first-test ,step-hack)))))
+         (when (and stepby-constantp start-constantp limit-constantp
+                    (realp start-value) (realp limit-value))
+           (when (setq first-test
+                       (funcall (symbol-function testfn)
+                                start-value
+                                limit-value))
+             (setq remaining-tests t)))
+         `(() (,indexv ,step)
+           ,remaining-tests ,step-hack () () ,first-test ,step-hack)))))
 \f
 ;;;; interfaces to the master sequencer
 
@@ -1816,21 +1816,21 @@ code to be loaded.
     nil (list (list kwd val)))))
 
 (defun loop-sequence-elements-path (variable data-type prep-phrases
-                                   &key
-                                   fetch-function
-                                   size-function
-                                   sequence-type
-                                   element-type)
+                                    &key
+                                    fetch-function
+                                    size-function
+                                    sequence-type
+                                    element-type)
   (multiple-value-bind (indexv) (loop-named-var 'index)
     (let ((sequencev (loop-named-var 'sequence)))
-      (list* nil nil                           ; dummy bindings and prologue
-            (loop-sequencer
-             indexv 'fixnum 
-             variable (or data-type element-type)
-             sequencev sequence-type
-             `(,fetch-function ,sequencev ,indexv)
-             `(,size-function ,sequencev)
-             prep-phrases)))))
+      (list* nil nil                            ; dummy bindings and prologue
+             (loop-sequencer
+              indexv 'fixnum
+              variable (or data-type element-type)
+              sequencev sequence-type
+              `(,fetch-function ,sequencev ,indexv)
+              `(,size-function ,sequencev)
+              prep-phrases)))))
 \f
 ;;;; builtin LOOP iteration paths
 
@@ -1842,39 +1842,39 @@ code to be loaded.
 ||#
 
 (defun loop-hash-table-iteration-path (variable data-type prep-phrases
-                                      &key (which (sb!int:missing-arg)))
+                                       &key (which (sb!int:missing-arg)))
   (declare (type (member :hash-key :hash-value) which))
   (cond ((or (cdr prep-phrases) (not (member (caar prep-phrases) '(:in :of))))
-        (loop-error "too many prepositions!"))
-       ((null prep-phrases)
-        (loop-error "missing OF or IN in ~S iteration path")))
+         (loop-error "too many prepositions!"))
+        ((null prep-phrases)
+         (loop-error "missing OF or IN in ~S iteration path")))
   (let ((ht-var (gensym "LOOP-HASHTAB-"))
-       (next-fn (gensym "LOOP-HASHTAB-NEXT-"))
-       (dummy-predicate-var nil)
-       (post-steps nil))
+        (next-fn (gensym "LOOP-HASHTAB-NEXT-"))
+        (dummy-predicate-var nil)
+        (post-steps nil))
     (multiple-value-bind (other-var other-p)
-       (loop-named-var (ecase which
-                         (:hash-key 'hash-value)
-                         (:hash-value 'hash-key)))
+        (loop-named-var (ecase which
+                          (:hash-key 'hash-value)
+                          (:hash-value 'hash-key)))
       ;; @@@@ LOOP-NAMED-VAR returns a second value of T if the name
       ;; was actually specified, so clever code can throw away the
       ;; GENSYM'ed-up variable if it isn't really needed. The
       ;; following is for those implementations in which we cannot put
       ;; dummy NILs into MULTIPLE-VALUE-SETQ variable lists.
       (setq other-p t
-           dummy-predicate-var (loop-when-it-var))
+            dummy-predicate-var (loop-when-it-var))
       (let* ((key-var nil)
-            (val-var nil)
-            (variable (or variable (gensym "LOOP-HASH-VAR-TEMP-")))
-            (bindings `((,variable nil ,data-type)
-                        (,ht-var ,(cadar prep-phrases))
-                        ,@(and other-p other-var `((,other-var nil))))))
-       (ecase which
-         (:hash-key (setq key-var variable
-                          val-var (and other-p other-var)))
-         (:hash-value (setq key-var (and other-p other-var)
-                            val-var variable)))
-       (push `(with-hash-table-iterator (,next-fn ,ht-var)) *loop-wrappers*)
+             (val-var nil)
+             (variable (or variable (gensym "LOOP-HASH-VAR-TEMP-")))
+             (bindings `((,variable nil ,data-type)
+                         (,ht-var ,(cadar prep-phrases))
+                         ,@(and other-p other-var `((,other-var nil))))))
+        (ecase which
+          (:hash-key (setq key-var variable
+                           val-var (and other-p other-var)))
+          (:hash-value (setq key-var (and other-p other-var)
+                             val-var variable)))
+        (push `(with-hash-table-iterator (,next-fn ,ht-var)) *loop-wrappers*)
         (when (or (consp key-var) data-type)
           (setq post-steps
                 `(,key-var ,(setq key-var (gensym "LOOP-HASH-KEY-TEMP-"))
@@ -1885,127 +1885,127 @@ code to be loaded.
                 `(,val-var ,(setq val-var (gensym "LOOP-HASH-VAL-TEMP-"))
                            ,@post-steps))
           (push `(,val-var nil) bindings))
-       `(,bindings                     ;bindings
-         ()                            ;prologue
-         ()                            ;pre-test
-         ()                            ;parallel steps
-         (not (multiple-value-setq (,dummy-predicate-var ,key-var ,val-var)
-                (,next-fn)))           ;post-test
-         ,post-steps)))))
+        `(,bindings                     ;bindings
+          ()                            ;prologue
+          ()                            ;pre-test
+          ()                            ;parallel steps
+          (not (multiple-value-setq (,dummy-predicate-var ,key-var ,val-var)
+                 (,next-fn)))           ;post-test
+          ,post-steps)))))
 
 (defun loop-package-symbols-iteration-path (variable data-type prep-phrases
-                                           &key symbol-types)
+                                            &key symbol-types)
   (cond ((and prep-phrases (cdr prep-phrases))
-        (loop-error "Too many prepositions!"))
+         (loop-error "Too many prepositions!"))
         ((and prep-phrases (not (member (caar prep-phrases) '(:in :of))))
          (sb!int:bug "Unknown preposition ~S." (caar prep-phrases))))
   (unless (symbolp variable)
     (loop-error "Destructuring is not valid for package symbol iteration."))
   (let ((pkg-var (gensym "LOOP-PKGSYM-"))
-       (next-fn (gensym "LOOP-PKGSYM-NEXT-"))
-       (variable (or variable (gensym "LOOP-PKGSYM-VAR-")))
+        (next-fn (gensym "LOOP-PKGSYM-NEXT-"))
+        (variable (or variable (gensym "LOOP-PKGSYM-VAR-")))
         (package (or (cadar prep-phrases) '*package*)))
     (push `(with-package-iterator (,next-fn ,pkg-var ,@symbol-types))
-         *loop-wrappers*)
+          *loop-wrappers*)
     `(((,variable nil ,data-type) (,pkg-var ,package))
       ()
       ()
       ()
       (not (multiple-value-setq (,(loop-when-it-var)
-                                ,variable)
-            (,next-fn)))
+                                 ,variable)
+             (,next-fn)))
       ())))
 \f
 ;;;; ANSI LOOP
 
 (defun make-ansi-loop-universe (extended-p)
   (let ((w (make-standard-loop-universe
-            :keywords '((named (loop-do-named))
-                        (initially (loop-do-initially))
-                        (finally (loop-do-finally))
-                        (do (loop-do-do))
-                        (doing (loop-do-do))
-                        (return (loop-do-return))
-                        (collect (loop-list-collection list))
-                        (collecting (loop-list-collection list))
-                        (append (loop-list-collection append))
-                        (appending (loop-list-collection append))
-                        (nconc (loop-list-collection nconc))
-                        (nconcing (loop-list-collection nconc))
-                        (count (loop-sum-collection count
-                                                    real
-                                                    fixnum))
-                        (counting (loop-sum-collection count
-                                                       real
-                                                       fixnum))
-                        (sum (loop-sum-collection sum number number))
-                        (summing (loop-sum-collection sum number number))
-                        (maximize (loop-maxmin-collection max))
-                        (minimize (loop-maxmin-collection min))
-                        (maximizing (loop-maxmin-collection max))
-                        (minimizing (loop-maxmin-collection min))
-                        (always (loop-do-always t nil)) ; Normal, do always
-                        (never (loop-do-always t t)) ; Negate test on always.
-                        (thereis (loop-do-thereis t))
-                        (while (loop-do-while nil :while)) ; Normal, do while
-                        (until (loop-do-while t :until)) ;Negate test on while
-                        (when (loop-do-if when nil))   ; Normal, do when
-                        (if (loop-do-if if nil))       ; synonymous
-                        (unless (loop-do-if unless t)) ; Negate test on when
-                        (with (loop-do-with))
+             :keywords '((named (loop-do-named))
+                         (initially (loop-do-initially))
+                         (finally (loop-do-finally))
+                         (do (loop-do-do))
+                         (doing (loop-do-do))
+                         (return (loop-do-return))
+                         (collect (loop-list-collection list))
+                         (collecting (loop-list-collection list))
+                         (append (loop-list-collection append))
+                         (appending (loop-list-collection append))
+                         (nconc (loop-list-collection nconc))
+                         (nconcing (loop-list-collection nconc))
+                         (count (loop-sum-collection count
+                                                     real
+                                                     fixnum))
+                         (counting (loop-sum-collection count
+                                                        real
+                                                        fixnum))
+                         (sum (loop-sum-collection sum number number))
+                         (summing (loop-sum-collection sum number number))
+                         (maximize (loop-maxmin-collection max))
+                         (minimize (loop-maxmin-collection min))
+                         (maximizing (loop-maxmin-collection max))
+                         (minimizing (loop-maxmin-collection min))
+                         (always (loop-do-always t nil)) ; Normal, do always
+                         (never (loop-do-always t t)) ; Negate test on always.
+                         (thereis (loop-do-thereis t))
+                         (while (loop-do-while nil :while)) ; Normal, do while
+                         (until (loop-do-while t :until)) ;Negate test on while
+                         (when (loop-do-if when nil))   ; Normal, do when
+                         (if (loop-do-if if nil))       ; synonymous
+                         (unless (loop-do-if unless t)) ; Negate test on when
+                         (with (loop-do-with))
                          (repeat (loop-do-repeat)))
-            :for-keywords '((= (loop-ansi-for-equals))
-                            (across (loop-for-across))
-                            (in (loop-for-in))
-                            (on (loop-for-on))
-                            (from (loop-for-arithmetic :from))
-                            (downfrom (loop-for-arithmetic :downfrom))
-                            (upfrom (loop-for-arithmetic :upfrom))
-                            (below (loop-for-arithmetic :below))
+             :for-keywords '((= (loop-ansi-for-equals))
+                             (across (loop-for-across))
+                             (in (loop-for-in))
+                             (on (loop-for-on))
+                             (from (loop-for-arithmetic :from))
+                             (downfrom (loop-for-arithmetic :downfrom))
+                             (upfrom (loop-for-arithmetic :upfrom))
+                             (below (loop-for-arithmetic :below))
                              (above (loop-for-arithmetic :above))
-                            (to (loop-for-arithmetic :to))
-                            (upto (loop-for-arithmetic :upto))
-                            (downto (loop-for-arithmetic :downto))
-                            (by (loop-for-arithmetic :by))
-                            (being (loop-for-being)))
-            :iteration-keywords '((for (loop-do-for))
-                                  (as (loop-do-for)))
-            :type-symbols '(array atom bignum bit bit-vector character
-                            compiled-function complex cons double-float
-                            fixnum float function hash-table integer
-                            keyword list long-float nil null number
-                            package pathname random-state ratio rational
-                            readtable sequence short-float simple-array
-                            simple-bit-vector simple-string simple-vector
-                            single-float standard-char stream string
-                            base-char symbol t vector)
-            :type-keywords nil
-            :ansi (if extended-p :extended t))))
+                             (to (loop-for-arithmetic :to))
+                             (upto (loop-for-arithmetic :upto))
+                             (downto (loop-for-arithmetic :downto))
+                             (by (loop-for-arithmetic :by))
+                             (being (loop-for-being)))
+             :iteration-keywords '((for (loop-do-for))
+                                   (as (loop-do-for)))
+             :type-symbols '(array atom bignum bit bit-vector character
+                             compiled-function complex cons double-float
+                             fixnum float function hash-table integer
+                             keyword list long-float nil null number
+                             package pathname random-state ratio rational
+                             readtable sequence short-float simple-array
+                             simple-bit-vector simple-string simple-vector
+                             single-float standard-char stream string
+                             base-char symbol t vector)
+             :type-keywords nil
+             :ansi (if extended-p :extended t))))
     (add-loop-path '(hash-key hash-keys) 'loop-hash-table-iteration-path w
-                  :preposition-groups '((:of :in))
-                  :inclusive-permitted nil
-                  :user-data '(:which :hash-key))
+                   :preposition-groups '((:of :in))
+                   :inclusive-permitted nil
+                   :user-data '(:which :hash-key))
     (add-loop-path '(hash-value hash-values) 'loop-hash-table-iteration-path w
-                  :preposition-groups '((:of :in))
-                  :inclusive-permitted nil
-                  :user-data '(:which :hash-value))
+                   :preposition-groups '((:of :in))
+                   :inclusive-permitted nil
+                   :user-data '(:which :hash-value))
     (add-loop-path '(symbol symbols) 'loop-package-symbols-iteration-path w
-                  :preposition-groups '((:of :in))
-                  :inclusive-permitted nil
-                  :user-data '(:symbol-types (:internal
-                                              :external
-                                              :inherited)))
+                   :preposition-groups '((:of :in))
+                   :inclusive-permitted nil
+                   :user-data '(:symbol-types (:internal
+                                               :external
+                                               :inherited)))
     (add-loop-path '(external-symbol external-symbols)
-                  'loop-package-symbols-iteration-path w
-                  :preposition-groups '((:of :in))
-                  :inclusive-permitted nil
-                  :user-data '(:symbol-types (:external)))
+                   'loop-package-symbols-iteration-path w
+                   :preposition-groups '((:of :in))
+                   :inclusive-permitted nil
+                   :user-data '(:symbol-types (:external)))
     (add-loop-path '(present-symbol present-symbols)
-                  'loop-package-symbols-iteration-path w
-                  :preposition-groups '((:of :in))
-                  :inclusive-permitted nil
-                  :user-data '(:symbol-types (:internal
-                                              :external)))
+                   'loop-package-symbols-iteration-path w
+                   :preposition-groups '((:of :in))
+                   :inclusive-permitted nil
+                   :user-data '(:symbol-types (:internal
+                                               :external)))
     w))
 
 (defparameter *loop-ansi-universe*
@@ -2015,7 +2015,7 @@ code to be loaded.
   (if (and keywords-and-forms (symbolp (car keywords-and-forms)))
       (loop-translate keywords-and-forms environment universe)
       (let ((tag (gensym)))
-       `(block nil (tagbody ,tag (progn ,@keywords-and-forms) (go ,tag))))))
+        `(block nil (tagbody ,tag (progn ,@keywords-and-forms) (go ,tag))))))
 
 (sb!int:defmacro-mundanely loop (&environment env &rest keywords-and-forms)
   (loop-standard-expansion keywords-and-forms env *loop-ansi-universe*))