diff --git a/src/code/old-loop.lisp b/src/code/old-loop.lisp
deleted file mode 100644
index cb492ec12eaf3d5ac33cbb2fb602bd7934266246..0000000000000000000000000000000000000000
--- a/src/code/old-loop.lisp
+++ /dev/null
@@ -1,828 +0,0 @@
-;;; -*- Package: LOOP -*-
-;;;
-;;; **********************************************************************
-;;; This code was written as part of the CMU Common Lisp project at
-;;; Carnegie Mellon University, and has been placed in the public domain.
-;;;
-(ext:file-comment
-  "$Header: src/code/old-loop.lisp $")
-;;;
-;;; **********************************************************************
-;;;
-;;; Loop facility, written by William Lott.
-;;; 
-(in-package "LOOP")
-(intl:textdomain "cmucl")
-
-(in-package "LISP")
-(export '(loop loop-finish))
-
-(in-package "LOOP")
-
-
-;;;; Specials used during the parse.
-
-;;; These specials hold the different parts of the result as we are generating
-;;; them.
-;;; 
-(defvar *loop-name*)
-(defvar *outside-bindings*)
-(defvar *prologue*)
-(defvar *inside-bindings*)
-(defvar *body-forms*)
-(defvar *iteration-forms*)
-(defvar *epilogue*)
-(defvar *result-var*)
-(defvar *return-value*)
-(defvar *default-return-value*)
-(defvar *accumulation-variables*)
-
-;;; This special holds the remaining stuff we need to parse.
-;;; 
-(defvar *remaining-stuff*)
-
-;;; This special holds a value that is EQ only to itself.
-;;; 
-(defvar *magic-cookie* (list '<magic-cookie>))
-
-
-;;;; Utility functions/macros used by the parser.
-
-(proclaim '(inline maybe-car maybe-cdr))
-
-(defun maybe-car (thing)
-  (if (consp thing) (car thing) thing))
-
-(defun maybe-cdr (thing)
-  (if (consp thing) (cdr thing) thing))
-
-
-(defmacro loop-keyword-p (thing keyword &rest more-keywords)
-  `(let ((thing ,thing))
-     (and (symbolp thing)
-	  (let ((name (symbol-name thing)))
-	    (or ,@(mapcar #'(lambda (keyword)
-			      `(string= name ,keyword))
-			  (cons keyword more-keywords)))))))
-
-(defun preposition-p (prep)
-  (when (loop-keyword-p (car *remaining-stuff*) prep)
-    (pop *remaining-stuff*)
-    t))
-
-
-(defun splice-in-subform (form subform)
-  (if (eq form *magic-cookie*)
-      subform
-      (labels ((sub-splice-in-subform (form path)
-		 (cond ((atom form)
-			nil)
-		       ((member form path)
-			nil)
-		       ((eq (car form) *magic-cookie*)
-			(setf (car form) subform)
-			t)
-		       (t
-			(let ((new-path (cons form path)))
-			  (or (sub-splice-in-subform (car form) new-path)
-			      (sub-splice-in-subform (cdr form) new-path)))))))
-	(if (sub-splice-in-subform form nil)
-	    form
-	    (error "Couldn't find the magic cookie in:~% ~S~%Loop is broken."
-		   form)))))
-
-(defmacro queue-var (where name type &key
-			   (initer nil initer-p) (stepper nil stepper-p))
-  `(push (list ,name ,type ,initer-p ,initer ,stepper-p ,stepper)
-	 ,where))
-
-(defvar *default-values* '(nil 0 0.0)
-  "The different possible default values.  When we need a default value, we
-  use the first value in this list that is typep the desired type.")
-
-(defun pick-default-value (var type)
-  (if (consp var)
-      (cons (pick-default-value (car var) (maybe-car type))
-	    (pick-default-value (cdr var) (maybe-cdr type)))
-      (dolist (default *default-values*
-		       (error "Cannot default variables of type ~S ~
-		               (for variable ~S)."
-			      type var))
-	(when (typep default type)
-	  (return default)))))
-
-(defun only-simple-types (type-spec)
-  (if (atom type-spec)
-      (member type-spec '(fixnum float t nil))
-      (and (only-simple-types (car type-spec))
-	   (only-simple-types (cdr type-spec)))))
-
-
-(defun build-let-expression (vars)
-  (if (null vars)
-      (values *magic-cookie* *magic-cookie*)
-      (let ((inside nil)
-	    (outside nil)
-	    (steppers nil)
-	    (sub-lets nil))
-	(dolist (var vars)
-	  (labels
-	      ((process (name type initial-p initial stepper-p stepper)
-	         (cond ((atom name)
-			(cond ((not stepper-p)
-			       (push (list type name initial) outside))
-			      ((not initial-p)
-			       (push (list type name stepper) inside))
-			      (t
-			       (push (list type name initial) outside)
-			       (setf steppers
-				     (nconc steppers (list name stepper))))))
-		       ((and (car name) (cdr name))
-			(let ((temp (gensym (format nil "TEMP-FOR-~A-" name))))
-			  (process temp 'list initial-p initial
-				   stepper-p stepper)
-			  (push (if stepper-p
-				    (list (car name)
-					  (maybe-car type)
-					  nil nil
-					  t `(car ,temp))
-				    (list (car name)
-					  (maybe-car type)
-					  t `(car ,temp)
-					  nil nil))
-				sub-lets)
-			  (push (if stepper-p
-				    (list (cdr name)
-					  (maybe-cdr type)
-					  nil nil
-					  t `(cdr ,temp))
-				    (list (car name)
-					  (maybe-cdr type)
-					  t `(cdr ,temp)
-					  nil nil))
-				sub-lets)))
-		       ((car name)
-			(process (car name)
-				 (maybe-car type)
-				 initial-p `(car ,initial)
-				 stepper-p `(car ,stepper)))
-		       ((cdr name)
-			(process (cdr name)
-				 (maybe-cdr type)
-				 initial-p `(cdr ,initial)
-				 stepper-p `(cdr ,stepper))))))
-	    (process (first var) (second var) (third var)
-		     (fourth var) (fifth var) (sixth var))))
-	(when steppers
-	  (push (cons 'psetq steppers)
-		*iteration-forms*))
-	(multiple-value-bind
-	    (sub-outside sub-inside)
-	    (build-let-expression sub-lets)
-	  (values (build-bindings outside sub-outside)
-		  (build-bindings inside sub-inside))))))
-
-(defun build-bindings (vars guts)
-  (if (null vars)
-      guts
-      `(let ,(mapcar #'cdr vars)
-	 (declare ,@(mapcar #'build-declare vars))
-	 ,guts)))
-
-(defun build-declare (var)
-  `(type ,(car var) ,(cadr var)))
-
-
-
-;;;; LOOP itself.
-
-(defmacro loop (&rest stuff)
-  "General iteration facility.  See the manual for details, 'cause it's
-  very confusing."
-  (if (some #'atom stuff)
-      (parse-loop stuff)
-      (let ((repeat (gensym "REPEAT-"))
-	    (out-of-here (gensym "OUT-OF-HERE-")))
-	`(block nil
-	   (tagbody
-	    ,repeat
-	    (macrolet ((loop-finish () `(go ,out-of-here)))
-	      ,@stuff)
-	    (go ,repeat)
-	    ,out-of-here)))))
-
-
-
-;;;; The parser.
-
-;;; Top level parser.  Bind the specials, and call the other parsers.
-;;; 
-(defun parse-loop (stuff)
-  (let* ((*prologue* nil)
-	 (*outside-bindings* *magic-cookie*)
-	 (*inside-bindings* *magic-cookie*)
-	 (*body-forms* nil)
-	 (*iteration-forms* nil)
-	 (*epilogue* nil)
-	 (*result-var* nil)
-	 (*return-value* nil)
-	 (*default-return-value* nil)
-	 (*accumulation-variables* nil)
-	 (*remaining-stuff* stuff)
-	 (name (parse-named)))
-    (loop
-      (when (null *remaining-stuff*)
-	(return))
-      (let ((clause (pop *remaining-stuff*)))
-	(cond ((not (symbolp clause))
-	       (error "Invalid clause, ~S, must be a symbol." clause))
-	      ((loop-keyword-p clause "INITIALLY")
-	       (setf *prologue* (nconc *prologue* (parse-expr-list))))
-	      ((loop-keyword-p clause "FINALLY")
-	       (parse-finally))
-	      ((loop-keyword-p clause "WITH")
-	       (parse-with))
-	      ((loop-keyword-p clause "FOR" "AS")
-	       (parse-for-as))
-	      ((loop-keyword-p clause "REPEAT")
-	       (parse-repeat))
-	      (t
-	       (push clause *remaining-stuff*)
-	       (return)))))
-    (loop
-      (when (null *remaining-stuff*)
-	(return))
-      (let ((clause (pop *remaining-stuff*)))
-	(cond ((not (symbolp clause))
-	       (error "Invalid clause, ~S, must be a symbol." clause))
-	      ((loop-keyword-p clause "INITIALLY")
-	       (setf *prologue* (nconc *prologue* (parse-expr-list))))
-	      ((loop-keyword-p clause "FINALLY")
-	       (parse-finally))
-	      ((loop-keyword-p clause "WHILE")
-	       (setf *body-forms*
-		     (nconc *body-forms*
-			    `((unless ,(pop *remaining-stuff*)
-				(loop-finish))))))
-	      ((loop-keyword-p clause "UNTIL")
-	       (setf *body-forms*
-		     (nconc *body-forms*
-			    `((when ,(pop *remaining-stuff*) (loop-finish))))))
-	      ((loop-keyword-p clause "ALWAYS")
-	       (setf *body-forms*
-		     (nconc *body-forms*
-			    `((unless ,(pop *remaining-stuff*)
-				(return-from ,name nil)))))
-	       (setf *default-return-value* t))
-	      ((loop-keyword-p clause "NEVER")
-	       (setf *body-forms*
-		     (nconc *body-forms*
-			    `((when ,(pop *remaining-stuff*)
-				(return-from ,name nil)))))
-	       (setf *default-return-value* t))
-	      ((loop-keyword-p clause "THEREIS")
-	       (setf *body-forms*
-		     (nconc *body-forms*
-			    (let ((temp (gensym "THEREIS-")))
-			      `((let ((,temp ,(pop *remaining-stuff*)))
-				  (when ,temp
-				    (return-from ,name ,temp))))))))
-	      (t
-	       (push clause *remaining-stuff*)
-	       (or (maybe-parse-unconditional)
-		   (maybe-parse-conditional)
-		   (maybe-parse-accumulation)
-		   (error "Unknown clause, ~S" clause))))))
-    (let ((again-tag (gensym "AGAIN-"))
-	  (end-tag (gensym "THIS-IS-THE-END-")))
-      `(block ,name
-	 ,(splice-in-subform
-	   *outside-bindings*
-	   `(macrolet ((loop-finish () '(go ,end-tag)))
-	      (tagbody
-	       ,@*prologue*
-	       ,again-tag
-	       ,(splice-in-subform
-		 *inside-bindings*
-		 `(progn
-		    ,@*body-forms*
-		    ,@(nreverse *iteration-forms*)))
-	       (go ,again-tag)
-	       ,end-tag
-	       ,@*epilogue*
-	       (return-from ,name
-			    ,(or *return-value*
-				 *default-return-value*
-				 *result-var*)))))))))
-
-(defun parse-named ()
-  (when (loop-keyword-p (car *remaining-stuff*) "NAMED")
-    (pop *remaining-stuff*)
-    (if (symbolp (car *remaining-stuff*))
-	(pop *remaining-stuff*)
-	(error "Loop name ~S is not a symbol." (car *remaining-stuff*)))))
-
-
-(defun parse-expr-list ()
-  (let ((results nil))
-    (loop
-      (when (atom (car *remaining-stuff*))
-	(return (nreverse results)))
-      (push (pop *remaining-stuff*) results))))
-
-(defun parse-finally ()
-  (let ((sub-clause (pop *remaining-stuff*)))
-    (if (loop-keyword-p sub-clause "RETURN")
-	(cond ((not (null *return-value*))
-	       (error "Cannot specify two FINALLY RETURN clauses."))
-	      ((null *remaining-stuff*)
-	       (error "FINALLY RETURN must be followed with an expression."))
-	      (t
-	       (setf *return-value* (pop *remaining-stuff*))))
-	(progn
-	  (unless (loop-keyword-p sub-clause "DO" "DOING")
-	    (push sub-clause *remaining-stuff*))
-	  (setf *epilogue* (nconc *epilogue* (parse-expr-list)))))))
-
-(defun parse-with ()
-  (let ((vars nil))
-    (loop
-      (multiple-value-bind (var type) (parse-var-and-type-spec)
-	(let ((initial
-	       (if (loop-keyword-p (car *remaining-stuff*) "=")
-		   (progn
-		     (pop *remaining-stuff*)
-		     (pop *remaining-stuff*))
-		   (list 'quote
-			 (pick-default-value var type)))))
-	  (queue-var vars var type :initer initial)))
-      (if (loop-keyword-p (car *remaining-stuff*) "AND")
-	  (pop *remaining-stuff*)
-	  (return)))
-    (multiple-value-bind
-	(outside inside)
-	(build-let-expression vars)
-      (setf *outside-bindings*
-	    (splice-in-subform *outside-bindings* outside))
-      (setf *inside-bindings*
-	    (splice-in-subform *inside-bindings* inside)))))
-
-(defun parse-var-and-type-spec ()
-  (values (pop *remaining-stuff*)
-	  (parse-type-spec t)))
-
-(defun parse-type-spec (default)
-  (cond ((preposition-p "OF-TYPE")
-	 (pop *remaining-stuff*))
-	((and *remaining-stuff*
-	      (only-simple-types (car *remaining-stuff*)))
-	 (pop *remaining-stuff*))
-	(t
-	 default)))
-
-
-
-;;;; FOR/AS stuff.
-
-;;; These specials hold the vars that need to be bound for this FOR/AS clause
-;;; and all of the FOR/AS clauses connected with AND.  All the *for-as-vars*
-;;; are bound in parallel followed by the *for-as-sub-vars*.
-;;; 
-(defvar *for-as-vars*)
-(defvar *for-as-sub-vars*)
-
-;;; These specials hold any extra termination tests.  *for-as-term-tests* are
-;;; processed after the *for-as-vars* are bound, but before the
-;;; *for-as-sub-vars*.  *for-as-sub-term-tests* are processed after the
-;;; *for-as-sub-vars*.
-
-(defvar *for-as-term-tests*)
-(defvar *for-as-sub-term-tests*)
-
-
-(defun parse-for-as ()
-  (let ((*for-as-vars* nil)
-	(*for-as-term-tests* nil)
-	(*for-as-sub-vars* nil)
-	(*for-as-sub-term-tests* nil))
-    (loop
-      (multiple-value-bind (name type) (parse-var-and-type-spec)
-	(let ((sub-clause (pop *remaining-stuff*)))
-	  (cond ((loop-keyword-p sub-clause "FROM" "DOWNFROM" "UPFROM"
-				 "TO" "DOWNTO" "UPTO" "BELOW" "ABOVE")
-		 (parse-arithmetic-for-as sub-clause name type))
-		((loop-keyword-p sub-clause "IN")
-		 (parse-in-for-as name type))
-		((loop-keyword-p sub-clause "ON")
-		 (parse-on-for-as name type))
-		((loop-keyword-p sub-clause "=")
-		 (parse-equals-for-as name type))
-		((loop-keyword-p sub-clause "ACROSS")
-		 (parse-across-for-as name type))
-		((loop-keyword-p sub-clause "BEING")
-		 (parse-being-for-as name type))
-		(t
-		 (error "Invalid FOR/AS subclause: ~S" sub-clause)))))
-      (if (loop-keyword-p (car *remaining-stuff*) "AND")
-	  (pop *remaining-stuff*)
-	  (return)))
-    (multiple-value-bind
-	(outside inside)
-	(build-let-expression *for-as-vars*)
-      (multiple-value-bind
-	  (sub-outside sub-inside)
-	  (build-let-expression *for-as-sub-vars*)
-	(setf *outside-bindings*
-	      (splice-in-subform *outside-bindings*
-				 (splice-in-subform outside sub-outside)))
-	(let ((inside-body
-	       (if *for-as-term-tests*
-		   `(if (or ,@(nreverse *for-as-term-tests*))
-			(loop-finish)
-			,*magic-cookie*)
-		   *magic-cookie*))
-	      (sub-inside-body
-	       (if *for-as-sub-term-tests*
-		   `(if (or ,@(nreverse *for-as-sub-term-tests*))
-			(loop-finish)
-			,*magic-cookie*)
-		   *magic-cookie*)))
-	  (setf *inside-bindings*
-		(splice-in-subform
-		 *inside-bindings*
-		 (splice-in-subform
-		  inside
-		  (splice-in-subform
-		   inside-body
-		   (splice-in-subform
-		    sub-inside
-		    sub-inside-body))))))))))
-
-(defun parse-arithmetic-for-as (sub-clause name type)
-  (unless (atom name)
-    (error "Cannot destructure arithmetic FOR/AS variables: ~S" name))
-  (let (start stop (inc 1) dir exclusive-p)
-    (cond ((loop-keyword-p sub-clause "FROM")
-	   (setf start (pop *remaining-stuff*)))
-	  ((loop-keyword-p sub-clause "DOWNFROM")
-	   (setf start (pop *remaining-stuff*))
-	   (setf dir :down))
-	  ((loop-keyword-p sub-clause "UPFROM")
-	   (setf start (pop *remaining-stuff*))
-	   (setf dir :up))
-	  (t
-	   (push sub-clause *remaining-stuff*)))
-    (cond ((preposition-p "TO")
-	   (setf stop (pop *remaining-stuff*)))
-	  ((preposition-p "DOWNTO")
-	   (setf stop (pop *remaining-stuff*))
-	   (if (eq dir :up)
-	       (error "Can't mix UPFROM and DOWNTO in ~S." name)
-	       (setf dir :down)))
-	  ((preposition-p "UPTO")
-	   (setf stop (pop *remaining-stuff*))
-	   (if (eq dir :down)
-	       (error "Can't mix DOWNFROM and UPTO in ~S." name)
-	       (setf dir :up)))
-	  ((preposition-p "ABOVE")
-	   (setf stop (pop *remaining-stuff*))
-	   (setf exclusive-p t)
-	   (if (eq dir :up)
-	       (error "Can't mix UPFROM and ABOVE in ~S." name)
-	       (setf dir :down)))
-	  ((preposition-p "BELOW")
-	   (setf stop (pop *remaining-stuff*))
-	   (setf exclusive-p t)
-	   (if (eq dir :down)
-	       (error "Can't mix DOWNFROM and BELOW in ~S." name)
-	       (setf dir :up))))
-    (when (preposition-p "BY")
-      (setf inc (pop *remaining-stuff*)))
-    (when (and (eq dir :down) (null start))
-      (error "No default starting value for decremental stepping."))
-    (let ((temp (gensym "TEMP-AMOUNT-")))
-      (queue-var *for-as-sub-vars* temp type :initer inc)
-      (queue-var *for-as-sub-vars* name type
-		 :initer (or start 0)
-		 :stepper `(,(if (eq dir :down) '- '+) ,name ,temp))
-      (when stop
-	(let ((stop-var (gensym "STOP-VAR-")))
-	  (queue-var *for-as-sub-vars* stop-var type :initer stop)
-	  (push (list (if (eq dir :down)
-			  (if exclusive-p '<= '<)
-			  (if exclusive-p '>= '>))
-		      name stop-var)
-		*for-as-sub-term-tests*))))))
-
-(defun parse-in-for-as (name type)
-  (let* ((temp (gensym "LIST-"))
-	 (initer (pop *remaining-stuff*))
-	 (stepper (if (preposition-p "BY")
-		      `(funcall ,(pop *remaining-stuff*) ,temp)
-		      `(cdr ,temp))))
-    (queue-var *for-as-vars* temp 'list :initer initer :stepper stepper)
-    (queue-var *for-as-sub-vars* name type :stepper `(car ,temp))
-    (push `(null ,temp) *for-as-sub-term-tests*)))
-
-(defun parse-on-for-as (name type)
-  (let* ((temp (if (atom name) name (gensym "LIST-")))
-	 (initer (pop *remaining-stuff*))
-	 (stepper (if (preposition-p "BY")
-		      `(funcall ,(pop *remaining-stuff*) ,temp)
-		      `(cdr ,temp))))
-    (cond ((atom name)
-	   (queue-var *for-as-sub-vars* name type
-		      :initer initer :stepper stepper)
-	   (push `(endp ,name) *for-as-sub-term-tests*))
-	  (t
-	   (queue-var *for-as-vars* temp type
-		      :initer initer :stepper stepper)
-	   (queue-var *for-as-sub-vars* name type :stepper temp)
-	   (push `(endp ,temp) *for-as-term-tests*)))))
-
-(defun parse-equals-for-as (name type)
-  (let ((initer (pop *remaining-stuff*)))
-    (if (preposition-p "THEN")
-	(queue-var *for-as-sub-vars* name type
-		   :initer initer :stepper (pop *remaining-stuff*))
-	(queue-var *for-as-vars* name type :stepper initer))))
-
-(defun parse-across-for-as (name type)
-  (let* ((temp (gensym "VECTOR-"))
-	 (length (gensym "LENGTH-"))
-	 (index (gensym "INDEX-")))
-    (queue-var *for-as-vars* temp `(vector ,type)
-	       :initer (pop *remaining-stuff*))
-    (queue-var *for-as-sub-vars* length 'fixnum
-	       :initer `(length ,temp))
-    (queue-var *for-as-vars* index 'fixnum :initer 0 :stepper `(1+ ,index))
-    (queue-var *for-as-sub-vars* name type :stepper `(aref ,temp ,index))
-    (push `(>= ,index ,length) *for-as-term-tests*)))
-
-(defun parse-being-for-as (name type)
-  (let ((clause (pop *remaining-stuff*)))
-    (unless (loop-keyword-p clause "EACH" "THE")
-      (error "BEING must be followed by either EACH or THE, not ~S"
-	     clause)))
-  (let ((clause (pop *remaining-stuff*)))
-    (cond ((loop-keyword-p clause "HASH-KEY" "HASH-KEYS"
- 			   "HASH-VALUE" "HASH-VALUES")
-	   (let ((prep (pop *remaining-stuff*)))
-	     (unless (loop-keyword-p prep "IN" "OF")
-	       (error "~A must be followed by either IN or OF, not ~S"
-		      (symbol-name clause) prep)))
-	   (let ((table (pop *remaining-stuff*))
-		 (iterator (gensym (format nil "~A-ITERATOR-" name)))
-		 (exists-temp (gensym (format nil "~A-EXISTS-TEMP-" name)))
-		 (key-temp (gensym (format nil "~A-KEY-TEMP-" name)))
-		 (value-temp (gensym (format nil "~A-VALUE-TEMP-" name))))
-	     (setf *outside-bindings*
-		   (splice-in-subform
-		    *outside-bindings*
-		    `(with-hash-table-iterator (,iterator ,table)
-					       ,*magic-cookie*)))
-	     (multiple-value-bind
-		 (using using-type)
-		 (when (preposition-p "USING")
-		   ;; ### This is wrong.
-		   (parse-var-and-type-spec))
-	       (multiple-value-bind
-		   (key-var key-type value-var value-type)
-		   (if (loop-keyword-p clause "HASH-KEY" "HASH-KEYS")
-		       (values name type using using-type)
-		       (values using using-type name type))
-		 (setf *inside-bindings*
-		       (splice-in-subform
-			*inside-bindings*
-			`(multiple-value-bind
-			     (,exists-temp ,key-temp ,value-temp)
-			     (,iterator)
-			   ,@(unless (and key-var value-var)
-			       `((declare (ignore ,@(if (null key-var)
-							(list key-temp))
-						  ,@(if (null value-var)
-							(list value-temp))))))
-			   ,*magic-cookie*)))
-		 (push `(not ,exists-temp) *for-as-term-tests*)
-		 (when key-var
-		   (queue-var *for-as-sub-vars* key-var key-type
-			      :stepper key-temp))
-		 (when value-var
-		   (queue-var *for-as-sub-vars* value-var value-type
-			      :stepper value-temp))))))
-	  ((loop-keyword-p clause "SYMBOL" "PRESENT-SYMBOL" "EXTERNAL-SYMBOL"
-			   "SYMBOLS" "PRESENT-SYMBOLS" "EXTERNAL-SYMBOLS")
-	   (let ((package
-		  (if (or (preposition-p "IN")
-			  (preposition-p "OF"))
-		      (pop *remaining-stuff*)
-		      '*package*))
-		 (iterator (gensym (format nil "~A-ITERATOR-" name)))
-		 (exists-temp (gensym (format nil "~A-EXISTS-TEMP-" name)))
-		 (symbol-temp (gensym (format nil "~A-SYMBOL-TEMP-" name))))
-	     (setf *outside-bindings*
-		   (splice-in-subform
-		    *outside-bindings*
-		    `(with-package-iterator
-			 (,iterator
-			  ,package
-			  ,@(cond ((loop-keyword-p clause "SYMBOL" "SYMBOLS")
-				   '(:internal :external :inherited))
-				  ((loop-keyword-p clause "PRESENT-SYMBOL"
-						   "PRESENT-SYMBOLS")
-				   '(:internal))
-				  ((loop-keyword-p clause "EXTERNAL-SYMBOL"
-						   "EXTERNAL-SYMBOLS")
-				   '(:external))
-				  (t
-				   (error "Don't know how to deal with ~A?  ~
-				           Bug in LOOP?" clause))))
-		       ,*magic-cookie*)))
-	     (setf *inside-bindings*
-		   (splice-in-subform
-		    *inside-bindings*
-		    `(multiple-value-bind
-			 (,exists-temp ,symbol-temp)
-			 (,iterator)
-		       ,*magic-cookie*)))
-	     (push `(not ,exists-temp) *for-as-term-tests*)
-	     (queue-var *for-as-sub-vars* name type :stepper symbol-temp)))
-	  (t
-	   (error
-	    "Unknown sub-clause, ~A, for BEING.  Must be one of:~%  ~
-	     HASH-KEY HASH-KEYS HASH-VALUE HASH-VALUES SYMBOL SYMBOLS~%  ~
-	     PRESENT-SYMBOL PRESENT-SYMBOLS EXTERNAL-SYMBOL EXTERNAL-SYMBOLS"
-	    (symbol-name clause))))))
-
-
-
-;;;;
-
-(defun parse-repeat ()
-  (let ((temp (gensym "REPEAT-")))
-    (setf *outside-bindings*
-	  (splice-in-subform *outside-bindings*
-			     `(let ((,temp ,(pop *remaining-stuff*)))
-				,*magic-cookie*)))
-    (setf *inside-bindings*
-	  (splice-in-subform *inside-bindings*
-			     `(if (minusp (decf ,temp))
-				  (loop-finish)
-				  ,*magic-cookie*)))))
-
-
-(defun maybe-parse-unconditional ()
-  (cond ((loop-keyword-p (car *remaining-stuff*) "DO" "DOING")
-	 (pop *remaining-stuff*)
-	 (setf *body-forms* (nconc *body-forms* (parse-expr-list)))
-	 t)
-	((loop-keyword-p (car *remaining-stuff*) "RETURN")
-	 (pop *remaining-stuff*)
-	 (setf *body-forms*
-	       (nconc *body-forms* `((return ,(pop *remaining-stuff*)))))
-	 t)))
-
-
-(defun maybe-parse-conditional ()
-  (let ((clause (pop *remaining-stuff*)))
-    (cond ((loop-keyword-p clause "IF" "WHEN")
-	   (parse-conditional (pop *remaining-stuff*))
-	   t)
-	  ((loop-keyword-p clause "UNLESS")
-	   (parse-conditional `(not ,(pop *remaining-stuff*)))
-	   t)
-	  (t
-	   (push clause *remaining-stuff*)
-	   nil))))
-
-(defun parse-conditional (condition)
-  (let ((clauses (parse-and-clauses))
-	(else-clauses (when (preposition-p "ELSE")
-			(parse-and-clauses))))
-    (setf *body-forms*
-	  (nconc *body-forms*
-		 `((if ,condition
-		       (progn
-			 ,@clauses)
-		       (progn
-			 ,@else-clauses)))))
-    (preposition-p "END")))
-
-(defun parse-and-clauses ()
-  (let ((*body-forms* nil))
-    (loop
-      (or (maybe-parse-unconditional)
-	  (maybe-parse-conditional)
-	  (maybe-parse-accumulation)
-	  (error "Invalid clause for inside a conditional: ~S"
-		 (car *remaining-stuff*)))
-      (unless (preposition-p "AND")
-	(return *body-forms*)))))
-
-
-;;;; Assumulation stuff
-
-(defun maybe-parse-accumulation ()
-  (when (loop-keyword-p (car *remaining-stuff*)
-		       "COLLECT" "COLLECTING"
-		       "APPEND" "APPENDING" "NCONC" "NCONCING"
-		       "COUNT" "COUNTING" "SUM" "SUMMING"
-		       "MAXIMIZE" "MAXIMIZING" "MINIMIZE" "MINIMIZING")
-    (parse-accumulation)
-    t))
-
-(defun parse-accumulation ()
-  (let* ((clause (pop *remaining-stuff*))
-	 (expr (pop *remaining-stuff*))
-	 (var (if (preposition-p "INTO")
-		  (pop *remaining-stuff*)
-		  (or *result-var*
-		      (setf *result-var*
-			    (gensym (concatenate 'simple-string
-						 (string clause)
-						 "-"))))))
-	 (info (assoc var *accumulation-variables*))
-	 (type nil)
-	 (initial nil))
-    (cond ((loop-keyword-p clause "COLLECT" "COLLECTING" "APPEND" "APPENDING"
-			   "NCONC" "NCONCING")
-	   (setf initial nil)
-	   (setf type 'list)
-	   (let ((aux-var
-		  (or (caddr info)
-		      (let ((aux-var (gensym "LAST-")))
-			(setf *outside-bindings*
-			      (splice-in-subform *outside-bindings*
-						 `(let ((,var nil)
-							(,aux-var nil))
-						    (declare (type list
-								   ,var
-								   ,aux-var))
-						    ,*magic-cookie*)))
-			(if (null info)
-			    (push (setf info (list var 'list aux-var))
-				  *accumulation-variables*)
-			    (setf (cddr info) (list aux-var)))
-			aux-var)))
-		 (value
-		  (cond ((loop-keyword-p clause "COLLECT" "COLLECTING")
-			 `(list ,expr))
-			((loop-keyword-p clause "APPEND" "APPENDING")
-			 `(copy-list ,expr))
-			((loop-keyword-p clause "NCONC" "NCONCING")
-			 expr)
-			(t
-			 (error "Bug in loop?")))))
-	     (setf *body-forms*
-		   (nconc *body-forms*
-			  `((cond ((null ,var)
-				   (setf ,var ,value)
-				   (setf ,aux-var (last ,var)))
-				  (t
-				   (nconc ,aux-var ,value)
-				   (setf ,aux-var (last ,aux-var)))))))))
-	  ((loop-keyword-p clause "COUNT" "COUNTING")
-	   (setf type (parse-type-spec 'unsigned-byte))
-	   (setf initial 0)
-	   (setf *body-forms*
-		 (nconc *body-forms*
-			`((when ,expr (incf ,var))))))
-	  ((loop-keyword-p clause "SUM" "SUMMING")
-	   (setf type (parse-type-spec 'number))
-	   (setf initial 0)
-	   (setf *body-forms*
-		 (nconc *body-forms*
-			`((incf ,var ,expr)))))
-	  ((loop-keyword-p clause "MAXIMIZE" "MAXIMIZING")
-	   (setf type `(or null ,(parse-type-spec 'number)))
-	   (setf initial nil)
-	   (setf *body-forms*
-		 (nconc *body-forms*
-			(let ((temp (gensym "MAX-TEMP-")))
-			  `((let ((,temp ,expr))
-			      (when (or (null ,var)
-					(> ,temp ,var))
-				(setf ,var ,temp))))))))
-	  ((loop-keyword-p clause "MINIMIZE" "MINIMIZING")
-	   (setf type `(or null ,(parse-type-spec 'number)))
-	   (setf initial nil)
-	   (setf *body-forms*
-		 (nconc *body-forms*
-			(let ((temp (gensym "MIN-TEMP-")))
-			  `((let ((,temp ,expr))
-			      (when (or (null ,var)
-					(< ,temp ,var))
-				(setf ,var ,temp))))))))
-	  (t
-	   (error "Invalid accumulation clause: ~S" clause)))
-    (cond (info
-	   (unless (equal type (cadr info))
-	     (error "Attempt to use ~S for both types ~S and ~S."
-		    var type (cadr info))))
-	  (t
-	   (push (list var type) *accumulation-variables*)
-	   (setf *outside-bindings*
-		 (splice-in-subform *outside-bindings*
-				    `(let ((,var ,initial))
-				       (declare (type ,type ,var))
-				       ,*magic-cookie*)))))))