diff --git a/pcl/boot.lisp b/pcl/boot.lisp
index e388f857f976258e399809c337cf302f55af46d5..b0819bc93a4ae7a7190aa6642ff60639d2595bae 100644
--- a/pcl/boot.lisp
+++ b/pcl/boot.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.27 2002/03/12 16:22:23 pmai Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.28 2002/08/26 02:23:10 pmai Exp $")
 
 (in-package :pcl)
 
@@ -103,8 +103,8 @@ work during bootstrapping.
 (defun redirect-early-function-internal (real early)
   (setf (gdefinition real)
 	(set-function-name
-	 #'(lambda (&rest args)
-	     (apply (the function (symbol-function early)) args))
+	 (lambda (&rest args)
+	   (apply (the function (symbol-function early)) args))
 	 real)))
 
 (dolist (fns *early-functions*)
@@ -328,8 +328,8 @@ work during bootstrapping.
 				       (class-name (class-of proto-method))
 				       'standard-method)
 				   initargs-form
-	                           (getf (getf initargs ':plist)
-				         ':pv-table-symbol))))))))
+	                           (getf (getf initargs :plist)
+				         :pv-table-symbol))))))))
 
 (defun interned-symbol-p (x)
   (and (symbolp x) (symbol-package x)))
@@ -342,16 +342,16 @@ work during bootstrapping.
 				    (and (eq (car name) 'setf) (cadr name))
 				    name))
 	     (every #'interned-symbol-p qualifiers)
-	     (every #'(lambda (s)
-			(if (consp s)
-			    (and (eq (car s) 'eql) 
-				 (constantp (cadr s))
-				 (let ((sv (eval (cadr s))))
-				   (or (interned-symbol-p sv)
-				       (integerp sv)
-				       (and (characterp sv)
-					    (standard-char-p sv)))))
-			    (interned-symbol-p s)))
+	     (every (lambda (s)
+		      (if (consp s)
+			  (and (eq (car s) 'eql) 
+			       (constantp (cadr s))
+			       (let ((sv (eval (cadr s))))
+				 (or (interned-symbol-p sv)
+				     (integerp sv)
+				     (and (characterp sv)
+					  (standard-char-p sv)))))
+			  (interned-symbol-p s)))
 		    specializers)
 	     (consp initargs-form)
 	     (eq (car initargs-form) 'list*)
@@ -360,12 +360,12 @@ work during bootstrapping.
 	     (eq (car fn) 'function)
 	     (consp (setq fn-lambda (cadr fn)))
 	     (eq (car fn-lambda) 'lambda))
-	(let* ((specls (mapcar #'(lambda (specl)
-				   (if (consp specl)
-				       `(,(car specl) ,(eval (cadr specl)))
-				       specl))
+	(let* ((specls (mapcar (lambda (specl)
+				 (if (consp specl)
+				     `(,(car specl) ,(eval (cadr specl)))
+				     specl))
 			       specializers))
-	       (mname `(,(if (eq (cadr initargs-form) ':function)
+	       (mname `(,(if (eq (cadr initargs-form) :function)
 			     'method 'fast-method)
 			,name ,@qualifiers ,specls))
 	       (mname-sym (intern (let ((*print-pretty* nil))
@@ -383,10 +383,10 @@ work during bootstrapping.
 	 *defmethod-times*
 	 (make-defmethod-form-internal 
 	  name qualifiers 
-	  `(list ,@(mapcar #'(lambda (specializer)
-			       (if (consp specializer)
-				   ``(,',(car specializer) ,,(cadr specializer))
-				   `',specializer))
+	  `(list ,@(mapcar (lambda (specializer)
+			     (if (consp specializer)
+				 ``(,',(car specializer) ,,(cadr specializer))
+				 `',specializer))
 		    specializers))
 	  unspecialized-lambda-list method-class-name
 	  initargs-form
@@ -461,7 +461,7 @@ work during bootstrapping.
       (multiple-value-bind (parameters lambda-list specializers)
 	  (parse-specialized-lambda-list specialized-lambda-list)
 	(let* ((required-parameters
-		(mapcar #'(lambda (r s) (declare (ignore s)) r)
+		(mapcar (lambda (r s) (declare (ignore s)) r)
 			parameters
 			specializers))
 	       (slots (mapcar #'list required-parameters))
@@ -475,9 +475,9 @@ work during bootstrapping.
 	       (class-declarations
 		`(declare
 		  ,@(remove nil
-			    (mapcar #'(lambda (a s) (and (symbolp s)
-							 (neq s 't)
-							 `(class ,a ,s)))
+			    (mapcar (lambda (a s) (and (symbolp s)
+						       (neq s t)
+						       `(class ,a ,s)))
 				    parameters
 				    specializers))))
 	       (method-lambda
@@ -519,7 +519,7 @@ work during bootstrapping.
 		  (extract-declarations (cddr walked-lambda))
 		(declare (ignore ignore))
 		(when (or next-method-p-p call-next-method-p)
-		  (setq plist (list* :needs-next-methods-p 't plist)))
+		  (setq plist (list* :needs-next-methods-p t plist)))
 		(when (some #'cdr slots)
 		  (multiple-value-bind (slot-name-lists call-list)
 		      (slot-name-lists-from-slots slots calls)
@@ -784,23 +784,23 @@ work during bootstrapping.
     (fast-method-call (let* ((arg-info (gf-arg-info gf))
 			     (nreq (arg-info-number-required arg-info))
 			     (restp (arg-info-applyp arg-info)))
-			#'(lambda (&rest args)
-			    #+copy-&rest-arg (setq args (copy-list args))
-			    (trace-emf-call emf t args)
-			    (apply (fast-method-call-function emf)
-				   (fast-method-call-pv-cell emf)
-				   (fast-method-call-next-method-call emf)
-				   (if restp
-				       (let* ((rest-args (nthcdr nreq args))
-					      (req-args (ldiff args rest-args)))
-					 (nconc req-args rest-args))
-				       args)))))
-    (method-call #'(lambda (&rest args)
-		     #+copy-&rest-arg (setq args (copy-list args))
-		     (trace-emf-call emf t args)
-		     (apply (method-call-function emf)
-			    args
-			    (method-call-call-method-args emf))))
+			(lambda (&rest args)
+			  #+copy-&rest-arg (setq args (copy-list args))
+			  (trace-emf-call emf t args)
+			  (apply (fast-method-call-function emf)
+				 (fast-method-call-pv-cell emf)
+				 (fast-method-call-next-method-call emf)
+				 (if restp
+				     (let* ((rest-args (nthcdr nreq args))
+					    (req-args (ldiff args rest-args)))
+				       (nconc req-args rest-args))
+				     args)))))
+    (method-call (lambda (&rest args)
+		   #+copy-&rest-arg (setq args (copy-list args))
+		   (trace-emf-call emf t args)
+		   (apply (method-call-function emf)
+			  args
+			  (method-call-call-method-args emf))))
     (function emf)))
 
 (defmacro bind-fast-lexical-method-macros ((args rest-arg next-method-call)
@@ -937,21 +937,21 @@ work during bootstrapping.
 	(next-method-p-p nil))     ;flag indicating that next-method-p
 				   ;should be in the method definition
     (flet ((walk-function (form context env)
-	     (cond ((not (eq context ':eval)) form)
+	     (cond ((not (eq context :eval)) form)
 		   ((not (listp form)) form)
 		   ((eq (car form) 'call-next-method)
-		    (setq call-next-method-p 't)
+		    (setq call-next-method-p t)
 		    form)
 		   ((eq (car form) 'next-method-p)
-		    (setq next-method-p-p 't)
+		    (setq next-method-p-p t)
 		    form)
 		   ((and (eq (car form) 'function)
 			 (cond ((eq (cadr form) 'call-next-method)
-				(setq call-next-method-p 't)
+				(setq call-next-method-p t)
 				(setq closurep t)
 				form)
 			       ((eq (cadr form) 'next-method-p)
-				(setq next-method-p-p 't)
+				(setq next-method-p-p t)
 				(setq closurep t)
 				form)
 			       (t nil))))
@@ -1015,20 +1015,17 @@ work during bootstrapping.
 	   (dolist (decl (cdar declarations))
 	     (when (and (eq (car decl) 'ignore)
 			(memq symbol (cdr decl)))
-	       (return t)))))	   
-    (gathering ((references (collecting)))
-      (iterate ((s (list-elements specialized-lambda-list))
-		(p (list-elements required-parameters)))
-	(progn p)
-	(cond ((not (listp s)))
-	      ((ignoredp (car s))
-	       (warn "In defmethod ~S, there is a~%~
-                      redundant ignore declaration for the parameter ~S."
-		     method-name
-		     specializers
-		     (car s)))
-	      (t
-	       (gather (car s) references)))))))
+	       (return t)))))
+    (loop for s in specialized-lambda-list
+	  and p in required-parameters
+	  when (listp s)
+	    if (ignoredp (car s)) do
+	      (warn "In defmethod ~S, there is a~%~
+                     redundant ignore declaration for the parameter ~S."
+		    method-name specializers (car s))
+	    else
+	      collect (car s))))
+
 
 
 (defvar *method-function-plist* (make-hash-table :test #'eq))
@@ -1084,16 +1081,16 @@ work during bootstrapping.
 
 (defun load-defmethod (class name quals specls ll initargs &optional pv-table-symbol)
   (setq initargs (copy-tree initargs))
-  (let ((method-spec (or (getf initargs ':method-spec)
+  (let ((method-spec (or (getf initargs :method-spec)
 			 (make-method-spec name quals specls))))
-    (setf (getf initargs ':method-spec) method-spec)
+    (setf (getf initargs :method-spec) method-spec)
     (load-defmethod-internal class name quals specls ll initargs pv-table-symbol)))
 
 (defun load-defmethod-internal
     (method-class gf-spec qualifiers specializers lambda-list 
 		  initargs pv-table-symbol)
   (when pv-table-symbol
-    (setf (getf (getf initargs ':plist) :pv-table-symbol)
+    (setf (getf (getf initargs :plist) :pv-table-symbol)
 	  pv-table-symbol))
   (let ((method (apply #'add-named-method
 		       gf-spec qualifiers specializers lambda-list
@@ -1118,12 +1115,12 @@ work during bootstrapping.
   `(method ,gf-spec ,@qualifiers ,unparsed-specializers))
 
 (defun initialize-method-function (initargs &optional return-function-p method)
-  (let* ((mf (getf initargs ':function))
-	 (method-spec (getf initargs ':method-spec))
-	 (plist (getf initargs ':plist))
-	 (pv-table-symbol (getf plist ':pv-table-symbol))
+  (let* ((mf (getf initargs :function))
+	 (method-spec (getf initargs :method-spec))
+	 (plist (getf initargs :plist))
+	 (pv-table-symbol (getf plist :pv-table-symbol))
 	 (pv-table nil)
-	 (mff (getf initargs ':fast-function)))
+	 (mff (getf initargs :fast-function)))
     (flet ((set-mf-property (p v)
 	     (when mf
 	       (setf (method-function-get mf p) v))
@@ -1180,10 +1177,10 @@ work during bootstrapping.
 	(if (memq x lambda-list-keywords)
 	    (case x
 	      (&optional         (setq state 'optional))
-	      (&key              (setq keysp 't
+	      (&key              (setq keysp t
 				       state 'key))
-	      (&allow-other-keys (setq allow-other-keys-p 't))
-	      (&rest             (setq restp 't
+	      (&allow-other-keys (setq allow-other-keys-p t))
+	      (&rest             (setq restp t
 				       state 'rest))
 	      (&aux              (return t))
 	      (otherwise
@@ -1218,16 +1215,16 @@ work during bootstrapping.
 	   (old-keysp (and old-ftype (c::function-type-keyp old-ftype)))
 	   (old-allowp (and old-ftype (c::function-type-allowp old-ftype)))
 	   (keywords (union old-keys (mapcar #'keyword-spec-name keywords))))
-      `(function ,(append (make-list nrequired :initial-element 't)
+      `(function ,(append (make-list nrequired :initial-element t)
 			  (when (plusp noptional)
 			    (append '(&optional)
-				    (make-list noptional :initial-element 't)))
+				    (make-list noptional :initial-element t)))
 			  (when (or restp old-restp)
 			    '(&rest t))
 			  (when (or keysp old-keysp)
 			    (append '(&key)
-				    (mapcar #'(lambda (key)
-						`(,key t))
+				    (mapcar (lambda (key)
+					      `(,key t))
 					    keywords)
 				    (when (or allow-other-keys-p old-allowp)
 				      '(&allow-other-keys)))))
@@ -1280,13 +1277,13 @@ work during bootstrapping.
 		     'standard-generic-function))
 
 (defvar *sgf-slots-init*
-  (mapcar #'(lambda (canonical-slot)
-	      (if (memq (getf canonical-slot :name) '(arg-info source))
-		  *slot-unbound*
-		  (let ((initfunction (getf canonical-slot :initfunction)))
-		    (if initfunction
-			(funcall initfunction)
-			*slot-unbound*))))
+  (mapcar (lambda (canonical-slot)
+	    (if (memq (getf canonical-slot :name) '(arg-info source))
+		*slot-unbound*
+		(let ((initfunction (getf canonical-slot :initfunction)))
+		  (if initfunction
+		      (funcall initfunction)
+		      *slot-unbound*))))
 	  (early-collect-inheritance 'standard-generic-function)))
 
 (defvar *sgf-method-class-index* 
@@ -1344,7 +1341,7 @@ work during bootstrapping.
   (length (arg-info-metatypes arg-info)))
 
 (defun arg-info-nkeys (arg-info)
-  (count-if #'(lambda (x) (neq x 't)) (arg-info-metatypes arg-info)))
+  (count-if (lambda (x) (neq x t)) (arg-info-metatypes arg-info)))
 
 ;;; Keep pages clean by not setting if the value is already the same.
 (defmacro esetf (pos val)
@@ -1366,7 +1363,7 @@ work during bootstrapping.
     (when (and (not lambda-list-p) methods)      
       (setq lambda-list (gf-lambda-list gf)))
     (when (or lambda-list-p
-	      (and first-p (eq (arg-info-lambda-list arg-info) ':no-lambda-list)))
+	      (and first-p (eq (arg-info-lambda-list arg-info) :no-lambda-list)))
       (multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords)
 	  (analyze-lambda-list lambda-list)
 	(when (and methods (not first-p))
@@ -1424,7 +1421,7 @@ work during bootstrapping.
 	(when (consp gf-keywords)
 	  (unless (or (and restp (not keysp))
 		      allow-other-keys-p
-		      (every #'(lambda (k) (memq k keywords)) gf-keywords))
+		      (every (lambda (k) (memq k keywords)) gf-keywords))
 	    (lose "the method does not accept each of the keyword arguments~%~
                  ~S." gf-keywords)))))))
 
@@ -1586,7 +1583,7 @@ work during bootstrapping.
   (let ((arg-info (if (eq *boot-state* 'complete)
 		      (gf-arg-info gf)
 		      (early-gf-arg-info gf))))
-    (if (eq ':no-lambda-list (arg-info-lambda-list arg-info))
+    (if (eq :no-lambda-list (arg-info-lambda-list arg-info))
 	(let ((methods (if (eq *boot-state* 'complete)
 			   (generic-function-methods gf)
 			   (early-gf-methods gf))))
@@ -1673,7 +1670,7 @@ work during bootstrapping.
 		metatypes
 		arg-info))
     (values (length metatypes) applyp metatypes
-	    (count-if #'(lambda (x) (neq x 't)) metatypes)
+	    (count-if (lambda (x) (neq x t)) metatypes)
 	    arg-info)))
 
 (defun early-make-a-method (class qualifiers arglist specializers initargs doc
@@ -1689,17 +1686,17 @@ work during bootstrapping.
     ;; Note that the use of not symbolp in this call to every should be
     ;; read as 'classp' we can't use classp itself because it doesn't
     ;; exist yet.
-    (if (every #'(lambda (s) (not (symbolp s))) specializers)
+    (if (every (lambda (s) (not (symbolp s))) specializers)
 	(setq parsed specializers
-	      unparsed (mapcar #'(lambda (s)
-				   (if (eq s 't) 't (class-name s)))
+	      unparsed (mapcar (lambda (s)
+				 (if (eq s t) t (class-name s)))
 			       specializers))
 	(setq unparsed specializers
 	      parsed ()))
     (list :early-method		  ;This is an early method dammit!
 	  
-	  (getf initargs ':function)
-	  (getf initargs ':fast-function)
+	  (getf initargs :function)
+	  (getf initargs :fast-function)
 	  
 	  parsed                  ;The parsed specializers.  This is used
 				  ;by early-method-specializers to cache
@@ -1761,7 +1758,7 @@ work during bootstrapping.
 (defun early-method-specializers (early-method &optional objectsp)
   (if (and (listp early-method)
 	   (eq (car early-method) :early-method))
-      (cond ((eq objectsp 't)
+      (cond ((eq objectsp t)
 	     (or (fourth early-method)
 		 (setf (fourth early-method)
 		       (mapcar #'find-class (cadddr (fifth early-method))))))
@@ -1836,7 +1833,7 @@ work during bootstrapping.
       (or (dolist (m (early-gf-methods generic-function))
 	    (when (and (or (equal (early-method-specializers m nil)
 				  specializers)
-			   (equal (early-method-specializers m 't)
+			   (equal (early-method-specializers m t)
 				  specializers))
 		       (equal (early-method-qualifiers m) qualifiers))
 	      (return m)))
@@ -1880,11 +1877,11 @@ work during bootstrapping.
     (dolist (early-gf-spec *early-generic-functions*)
       (when noisyp (format t "~&~S..." early-gf-spec))
       (let* ((gf (gdefinition early-gf-spec))
-	     (methods (mapcar #'(lambda (early-method)
-				  (let ((args (copy-list (fifth early-method))))
-				    (setf (fourth args)
-					  (early-method-specializers early-method t))
-				    (apply #'real-make-a-method args)))
+	     (methods (mapcar (lambda (early-method)
+				(let ((args (copy-list (fifth early-method))))
+				  (setf (fourth args)
+					(early-method-specializers early-method t))
+				  (apply #'real-make-a-method args)))
 			      (early-gf-methods gf))))
 	(setf (generic-function-method-class gf) *the-class-standard-method*)
 	(setf (generic-function-method-combination gf) *standard-method-combination*)
@@ -1896,26 +1893,26 @@ work during bootstrapping.
     (dolist (fixup *generic-function-fixups*)
       (let* ((fspec (car fixup))
 	     (gf (gdefinition fspec))
-	     (methods (mapcar #'(lambda (method)
-				  (let* ((lambda-list (first method))
-					 (specializers (second method))
-					 (method-fn-name (third method))
-					 (fn-name (or method-fn-name fspec))
-					 (fn (symbol-function fn-name))
-					 (initargs 
-					  (list :function
-						(set-function-name
-						 #'(lambda (args next-methods)
-						     (declare (ignore next-methods))
-						     (apply fn args))
-						 `(call ,fn-name)))))
-				    (declare (type function fn))
-				    (make-a-method 'standard-method
-						   ()
-						   lambda-list
-						   specializers
-						   initargs
-						   nil)))
+	     (methods (mapcar (lambda (method)
+				(let* ((lambda-list (first method))
+				       (specializers (second method))
+				       (method-fn-name (third method))
+				       (fn-name (or method-fn-name fspec))
+				       (fn (symbol-function fn-name))
+				       (initargs 
+					(list :function
+					      (set-function-name
+					       (lambda (args next-methods)
+						 (declare (ignore next-methods))
+						 (apply fn args))
+					       `(call ,fn-name)))))
+				  (declare (type function fn))
+				  (make-a-method 'standard-method
+						 ()
+						 lambda-list
+						 specializers
+						 initargs
+						 nil)))
 			      (cdr fixup))))
 	(setf (generic-function-method-class gf) *the-class-standard-method*)
 	(setf (generic-function-method-combination gf) *standard-method-combination*)
@@ -2064,7 +2061,7 @@ work during bootstrapping.
 	       (parse-specialized-lambda-list (cdr arglist))
 	     (values (cons (if (listp arg) (car arg) arg) parameters)
 		     (cons (if (listp arg) (car arg) arg) lambda-list)
-		     (cons (if (listp arg) (cadr arg) 't) specializers)
+		     (cons (if (listp arg) (cadr arg) t) specializers)
 		     (cons (if (listp arg) (car arg) arg) required)))))))
 
 
@@ -2081,17 +2078,17 @@ work during bootstrapping.
 	   (and (symbolp instance)
                 `((declare (variable-rebinding ,in ,instance)))))
        ,in
-       (symbol-macrolet ,(mapcar #'(lambda (slot-entry)
-				     (let ((variable-name 
-					    (if (symbolp slot-entry)
-						slot-entry
-						(car slot-entry)))
-					   (slot-name
-					    (if (symbolp slot-entry)
-						slot-entry
-						(cadr slot-entry))))
-				       `(,variable-name
-					  (slot-value ,in ',slot-name))))
+       (symbol-macrolet ,(mapcar (lambda (slot-entry)
+				   (let ((variable-name 
+					  (if (symbolp slot-entry)
+					      slot-entry
+					      (car slot-entry)))
+					 (slot-name
+					  (if (symbolp slot-entry)
+					      slot-entry
+					      (cadr slot-entry))))
+				     `(,variable-name
+				       (slot-value ,in ',slot-name))))
 				 slots)
 			,@body))))
 
@@ -2106,11 +2103,11 @@ work during bootstrapping.
 	   (and (symbolp instance)
                 `((declare (variable-rebinding ,in ,instance)))))
        ,in
-       (symbol-macrolet ,(mapcar #'(lambda (slot-entry)
+       (symbol-macrolet ,(mapcar (lambda (slot-entry)
 				   (let ((variable-name (car slot-entry))
 					 (accessor-name (cadr slot-entry)))
 				     `(,variable-name
-				        (,accessor-name ,in))))
+				       (,accessor-name ,in))))
 			       slots)
           ,@body))))
 
diff --git a/pcl/braid.lisp b/pcl/braid.lisp
index 8fe1de4b024d49bbc405895172aa975a295f99c9..45fb7b2d9b1ef322480be8152c7f1cb534d285f2 100644
--- a/pcl/braid.lisp
+++ b/pcl/braid.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.21 2002/07/03 10:57:17 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.22 2002/08/26 02:23:11 pmai Exp $")
 ;;;
 ;;; Bootstrapping the meta-braid.
 ;;;
@@ -101,20 +101,20 @@
 ;;;   
 (defmacro initial-classes-and-wrappers (&rest classes)
   `(progn
-     ,@(mapcar #'(lambda (class)
-		   (let ((wr (intern (format nil "~A-WRAPPER" class) 
-				     *the-pcl-package*)))
-		     `(setf ,wr ,(if (eq class 'standard-generic-function)
-				     '*sgf-wrapper*
-				     `(boot-make-wrapper
-				       (early-class-size ',class)
-				       ',class))
-		            ,class (allocate-standard-instance
-				    ,(if (eq class 'standard-generic-function)
-					 'funcallable-standard-class-wrapper
-					 'standard-class-wrapper))
-		            (wrapper-class ,wr) ,class
-		            (find-class ',class) ,class)))
+     ,@(mapcar (lambda (class)
+		 (let ((wr (intern (format nil "~A-WRAPPER" class) 
+				   *the-pcl-package*)))
+		   `(setf ,wr ,(if (eq class 'standard-generic-function)
+				   '*sgf-wrapper*
+				   `(boot-make-wrapper
+				     (early-class-size ',class)
+				     ',class))
+			  ,class (allocate-standard-instance
+				  ,(if (eq class 'standard-generic-function)
+				       'funcallable-standard-class-wrapper
+				       'standard-class-wrapper))
+			  (wrapper-class ,wr) ,class
+			  (find-class ',class) ,class)))
 	      classes)))		        
 
 (defun bootstrap-meta-braid ()
@@ -192,7 +192,7 @@
 				  (t
 				   (boot-make-wrapper (length slots) name))))
 		   (proto nil))
-	      (when (eq name 't) (setq *the-wrapper-of-t* wrapper))
+	      (when (eq name t) (setq *the-wrapper-of-t* wrapper))
 	      (set (intern (format nil "*THE-CLASS-~A*" (symbol-name name))
 			   *the-pcl-package*)
 		   class)
@@ -265,7 +265,7 @@
 	   (bootstrap-set-slot metaclass-name class slot-name value)))
     (set-slot 'name name)
     (set-slot 'source source)
-    (set-slot 'type (if (eq class (find-class 't))
+    (set-slot 'type (if (eq class (find-class t))
 			t
 			`(class ,class)))
     (set-slot 'class-eq-specializer 
@@ -309,10 +309,10 @@
 
 (defun bootstrap-make-slot-definitions (name class slots wrapper effective-p)
   (let ((index -1))
-    (mapcar #'(lambda (slot)
-		(incf index)
-		(bootstrap-make-slot-definition
-		  name class slot wrapper effective-p index))
+    (mapcar (lambda (slot)
+	      (incf index)
+	      (bootstrap-make-slot-definition
+	       name class slot wrapper effective-p index))
 	    slots)))
 
 (defun bootstrap-make-slot-definition (name class slot wrapper effective-p index)  
@@ -381,7 +381,7 @@
 			(list class-name) (list class-name)
 			"automatically generated reader method"))
 	(writer (values 'standard-writer-method #'make-std-writer-method-function
-			(list 'new-value class-name) (list 't class-name)
+			(list 'new-value class-name) (list t class-name)
 			"automatically generated writer method"))
 	(boundp (values 'standard-boundp-method #'make-std-boundp-method-function
 			(list class-name) (list class-name)
@@ -429,7 +429,7 @@
   ;; 
   (dolist (e *built-in-classes*)
     (dolist (super (cadr e))
-      (unless (or (eq super 't)
+      (unless (or (eq super t)
 		  (assq super *built-in-classes*))
 	(error "In *built-in-classes*: ~S has ~S as a super,~%~
                 but ~S is not itself a class in *built-in-classes*."
@@ -488,7 +488,7 @@
 (defvar find-structure-class nil)
 
 (defun eval-form (form)
-  #'(lambda () (eval form)))
+  (lambda () (eval form)))
 
 (defun slot-initargs-from-structure-slotd (slotd)
   `(:name ,(structure-slotd-name slotd)
diff --git a/pcl/cache.lisp b/pcl/cache.lisp
index 4df562dcd3fd6c70fcbb288585ec041c34adbe8f..aa52ab938d33ab994a51618cf583a0c559956ffa 100644
--- a/pcl/cache.lisp
+++ b/pcl/cache.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.14 2000/07/06 08:15:02 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.15 2002/08/26 02:23:11 pmai Exp $")
 ;;;
 ;;; The basics of the PCL wrapper cache mechanism.
 ;;;
@@ -210,7 +210,7 @@
 ;;; 
 (defun show-free-cache-vectors ()
   (let ((elements ()))
-    (maphash #'(lambda (s e) (push (list s e) elements)) *free-cache-vectors*)
+    (maphash (lambda (s e) (push (list s e) elements)) *free-cache-vectors*)
     (setq elements (sort elements #'< :key #'car))
     (dolist (e elements)
       (let* ((size (car e))
@@ -329,7 +329,7 @@
 
 (defun (setf wrapper-state) (new-value wrapper)
   (setf (kernel:layout-invalid wrapper)
-	(if (eq new-value 't)
+	(if (eq new-value t)
 	    nil
 	  new-value)))
 
@@ -449,7 +449,7 @@
 ;;; 
 
 (defmacro invalid-wrapper-p (wrapper)
-  `(neq (wrapper-state ,wrapper) 't))
+  `(neq (wrapper-state ,wrapper) t))
 
 (defvar *previous-nwrappers* (make-hash-table))
 
@@ -467,15 +467,16 @@
        ;; kind of transitivity of wrapper updates.
        ;; 
        (dolist (previous (gethash owrapper *previous-nwrappers*))
-	 (when (eq state ':obsolete)
-	   (setf (car previous) ':obsolete))
+	 (when (eq state :obsolete)
+	   (setf (car previous) :obsolete))
 	 (setf (cadr previous) nwrapper)
 	 (push previous new-previous))
+
+       (loop with ocnv = (wrapper-cache-number-vector owrapper)
+	     for type in wrapper-layout and i from 0
+	     when (eq type 'number) do
+	       (setf (cache-number-vector-ref ocnv i) 0))
        
-       (let ((ocnv (wrapper-cache-number-vector owrapper)))
-	 (iterate ((type (list-elements wrapper-layout))
-		   (i (interval :from 0)))
-           (when (eq type 'number) (setf (cache-number-vector-ref ocnv i) 0))))
        (push (setf (wrapper-state owrapper) (list state nwrapper))
 	     new-previous)
        
@@ -485,7 +486,7 @@
 (defun check-wrapper-validity (instance)
   (let* ((owrapper (wrapper-of instance))
 	 (state (wrapper-state owrapper)))
-    (if (eq state  't)
+    (if (eq state  t)
 	owrapper
 	(let ((nwrapper
 		(ecase (car state)
@@ -763,8 +764,8 @@
 	      (wrapper nil)
 	      ,@(when wrappers
 		  `((class *the-class-t*)
-		    (type 't))))
-	 (unless (eq mt 't)
+		    (type t))))
+	 (unless (eq mt t)
 	   (setq wrapper (wrapper-of arg))
 	   (when (invalid-wrapper-p wrapper)
 	     (setq ,invalid-wrapper-p t)
@@ -790,8 +791,8 @@
 	 (let* (,@(when wrappers
 		    `((,wrappers (nreverse wrappers-rev))
 		      (,classes (nreverse classes-rev))
-		      (,types (mapcar #'(lambda (class)
-					  `(class-eq ,class))
+		      (,types (mapcar (lambda (class)
+					`(class-eq ,class))
 			              ,classes)))))
 	   ,@body))))
 
@@ -809,6 +810,10 @@
   (or (nth arg-number (the list *dfun-arg-symbols*))
       (intern (format nil ".ARG~A." arg-number) *the-pcl-package*)))
 
+(defun dfun-arg-symbol-list (metatypes)
+  (loop for i from 0 and s in metatypes
+        collect (dfun-arg-symbol i)))
+
 (defvar *slot-vector-symbols* '(.SLOTS0. .SLOTS1. .SLOTS2. .SLOTS3.))
 
 (defun slot-vector-symbol (arg-number)
@@ -816,68 +821,39 @@
       (intern (format nil ".SLOTS~A." arg-number) *the-pcl-package*)))
 
 (defun make-dfun-lambda-list (metatypes applyp)
-  (gathering1 (collecting)
-    (iterate ((i (interval :from 0))
-	      (s (list-elements metatypes)))
-      (progn s)
-      (gather1 (dfun-arg-symbol i)))
-    (when applyp
-      (gather1 '&rest)
-      (gather1 '.dfun-rest-arg.))))
+  (if applyp
+      (nconc (dfun-arg-symbol-list metatypes) (list '&rest '.dfun-rest-arg.))
+      (dfun-arg-symbol-list metatypes)))
 
 (defun make-dlap-lambda-list (metatypes applyp)
-  (gathering1 (collecting)
-    (iterate ((i (interval :from 0))
-	      (s (list-elements metatypes)))
-      (progn s)
-      (gather1 (dfun-arg-symbol i)))
-    (when applyp
-      (gather1 '&rest))))
+  (if applyp
+      (nconc (dfun-arg-symbol-list metatypes) (list '&rest))
+      (dfun-arg-symbol-list metatypes)))
 
 (defun make-emf-call (metatypes applyp fn-variable &optional emf-type)
-  (let ((required
-	 (gathering1 (collecting)
-	    (iterate ((i (interval :from 0))
-		      (s (list-elements metatypes)))
-	      (progn s)
-	      (gather1 (dfun-arg-symbol i))))))
+  (let ((required (dfun-arg-symbol-list metatypes)))
     `(,(if (eq emf-type 'fast-method-call)
 	   'invoke-effective-method-function-fast
 	   'invoke-effective-method-function)
       ,fn-variable ,applyp ,@required ,@(when applyp `(.dfun-rest-arg.)))))
 
 (defun make-dfun-call (metatypes applyp fn-variable)
-  (let ((required
-	  (gathering1 (collecting)
-	    (iterate ((i (interval :from 0))
-		      (s (list-elements metatypes)))
-	      (progn s)
-	      (gather1 (dfun-arg-symbol i))))))
+  (let ((required (dfun-arg-symbol-list metatypes)))
     (if applyp
 	`(function-apply   ,fn-variable ,@required .dfun-rest-arg.)
 	`(function-funcall ,fn-variable ,@required))))
 
 (defun make-dfun-arg-list (metatypes applyp)
-  (let ((required
-	  (gathering1 (collecting)
-	    (iterate ((i (interval :from 0))
-		      (s (list-elements metatypes)))
-	      (progn s)
-	      (gather1 (dfun-arg-symbol i))))))
+  (let ((required (dfun-arg-symbol-list metatypes)))
     (if applyp
 	`(list* ,@required .dfun-rest-arg.)
 	`(list ,@required))))
 
 (defun make-fast-method-call-lambda-list (metatypes applyp)
-  (gathering1 (collecting)
-    (gather1 '.pv-cell.)
-    (gather1 '.next-method-call.)
-    (iterate ((i (interval :from 0))
-	      (s (list-elements metatypes)))
-      (progn s)
-      (gather1 (dfun-arg-symbol i)))
-    (when applyp
-      (gather1 '.dfun-rest-arg.))))
+  (nconc (list '.pv-cell. '.next-method-call.)
+	 (dfun-arg-symbol-list metatypes)
+	 (when applyp
+	   (list '.dfun-rest-arg.))))
 
 
 ;;;
@@ -1077,12 +1053,12 @@
 (defmacro with-local-cache-functions ((cache) &body body)
   `(let ((.cache. ,cache))
      (declare (type cache .cache.))
-     (macrolet ,(mapcar #'(lambda (fn)
-			    `(,(car fn) ,(cadr fn)
-			        `(let (,,@(mapcar #'(lambda (var)
-						      ``(,',var ,,var))
-					          (cadr fn)))
-				    ,@',(cddr fn))))
+     (macrolet ,(mapcar (lambda (fn)
+			  `(,(car fn) ,(cadr fn)
+			     `(let (,,@(mapcar (lambda (var)
+						 ``(,',var ,,var))
+					       (cadr fn)))
+				,@',(cddr fn))))
 			*local-cache-functions*)
        ,@body)))
 
@@ -1423,8 +1399,8 @@
 
 (defun caches-to-allocate ()
   (sort (let ((l nil))
-	  (maphash #'(lambda (size entry)
-		       (push (list (car entry) size) l))
+	  (maphash (lambda (size entry)
+		     (push (list (car entry) size) l))
 		   pcl::*free-caches*)
 	  l)
 	#'> :key #'cadr))
diff --git a/pcl/combin.lisp b/pcl/combin.lisp
index e8ffe66fb602277daf11a762ebe967acba5812bc..25b0eeeb9606982bb787c9d245524b3e58ad3095 100644
--- a/pcl/combin.lisp
+++ b/pcl/combin.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/combin.lisp,v 1.10 2001/04/25 21:44:51 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/combin.lisp,v 1.11 2002/08/26 02:23:11 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -82,10 +82,10 @@
 	     (method (car cm-args)))
 	(when method
 	  (if (if (listp method)
-		  (eq (car method) ':early-method)
+		  (eq (car method) :early-method)
 		  (method-p method))
 	      (if method-alist-p
-		  't
+		  t
 		  (multiple-value-bind (mf fmf)
 		      (if (listp method)
 			  (early-method-function method)
@@ -121,9 +121,9 @@
 		     (null (cddr cm-args))))
 	 (method (car cm-args))
 	 (cm-args1 (cdr cm-args)))
-    #'(lambda (method-alist wrappers)
-	(make-effective-method-function-simple1 generic-function method cm-args1 fmf-p
-						method-alist wrappers))))
+    (lambda (method-alist wrappers)
+      (make-effective-method-function-simple1 generic-function method cm-args1 fmf-p
+					      method-alist wrappers))))
 
 (defun make-emf-from-method (method cm-args &optional gf fmf-p method-alist wrappers)
   (multiple-value-bind (mf real-mf-p fmf pv-cell)
@@ -134,7 +134,7 @@
 		      gf (car next-methods)
 		      (list* (cdr next-methods) (cdr cm-args))
 		      fmf-p method-alist wrappers))
-	       (arg-info (method-function-get fmf ':arg-info)))
+	       (arg-info (method-function-get fmf :arg-info)))
 	  (make-fast-method-call :function fmf
 				 :pv-cell pv-cell
 				 :next-method-call next
@@ -148,7 +148,7 @@
 						  &optional method-alist wrappers)
   (when method
     (if (if (listp method)
-	    (eq (car method) ':early-method)
+	    (eq (car method) :early-method)
 	    (method-p method))
 	(make-emf-from-method method cm-args gf fmf-p method-alist wrappers)
 	(if (and (consp method) (eq (car method) 'make-method))
@@ -201,14 +201,14 @@
 	   (t
 	    '.call-method.)))
 	((and (consp form) (eq (car form) 'call-method-list))
-	 (case (if (every #'(lambda (form)
-			      (eq 'fast-method-call
-				  (make-effective-method-function-type 
-				   generic-function form 
-				   method-alist-p wrappers-p)))
+	 (case (if (every (lambda (form)
+			    (eq 'fast-method-call
+				(make-effective-method-function-type 
+				 generic-function form 
+				 method-alist-p wrappers-p)))
 			  (cdr form))
 		   'fast-method-call
-		   't)
+		   t)
 	   (fast-method-call
 	    '.fast-call-method-list.)
 	   (t
@@ -226,14 +226,14 @@
 		   (list gensym))))
 	((and (consp form) (eq (car form) 'call-method-list))
 	 (let ((gensym (get-effective-method-gensym))
-	       (type (if (every #'(lambda (form)
-				    (eq 'fast-method-call
-					(make-effective-method-function-type 
-					 generic-function form 
-					 method-alist-p wrappers-p)))
+	       (type (if (every (lambda (form)
+				  (eq 'fast-method-call
+				      (make-effective-method-function-type 
+				       generic-function form 
+				       method-alist-p wrappers-p)))
 				(cdr form))
 			 'fast-method-call
-			 't)))
+			 t)))
 	   (values `(dolist (emf ,gensym nil)
 		      ,(make-emf-call metatypes applyp 'emf type))
 		   (list gensym))))		     
@@ -247,9 +247,9 @@
 		      generic-function form))))
 	((and (consp form) (eq (car form) 'call-method-list))
 	 (list (cons '.meth-list.
-		     (mapcar #'(lambda (form)
-				 (make-effective-method-function-simple
-				  generic-function form))
+		     (mapcar (lambda (form)
+			       (make-effective-method-function-simple
+				generic-function form))
 			     (cdr form)))))
 	(t
 	 (default-constant-converter form))))
@@ -268,42 +268,42 @@
 				     generic-function effective-method)))
       (multiple-value-bind (cfunction constants)
 	  (get-function1 effective-method-lambda
-			 #'(lambda (form)
-			     (memf-test-converter form generic-function
-						  method-alist-p wrappers-p))
-			 #'(lambda (form)
-			     (memf-code-converter form generic-function
-						  metatypes applyp
-						  method-alist-p wrappers-p))
-			 #'(lambda (form)
-			     (memf-constant-converter form generic-function)))
-	#'(lambda (method-alist wrappers)
-	    (let* ((constants 
-		    (mapcar #'(lambda (constant)
-				(if (consp constant)
-				    (case (car constant)
-				      (.meth.
-				       (funcall (cdr constant)
-						method-alist wrappers))
-				      (.meth-list.
-				       (mapcar #'(lambda (fn)
-						   (funcall fn method-alist wrappers))
-					       (cdr constant)))
-				      (t constant))
-				    constant))
-			    constants))
-		   (function (set-function-name
-			      (apply cfunction constants)
-			      `(combined-method ,name))))
-	      (make-fast-method-call :function function
-				     :arg-info arg-info)))))))
+			 (lambda (form)
+			   (memf-test-converter form generic-function
+						method-alist-p wrappers-p))
+			 (lambda (form)
+			   (memf-code-converter form generic-function
+						metatypes applyp
+						method-alist-p wrappers-p))
+			 (lambda (form)
+			   (memf-constant-converter form generic-function)))
+	(lambda (method-alist wrappers)
+	  (let* ((constants 
+		  (mapcar (lambda (constant)
+			    (if (consp constant)
+				(case (car constant)
+				  (.meth.
+				   (funcall (cdr constant)
+					    method-alist wrappers))
+				  (.meth-list.
+				   (mapcar (lambda (fn)
+					     (funcall fn method-alist wrappers))
+					   (cdr constant)))
+				  (t constant))
+				constant))
+			  constants))
+		 (function (set-function-name
+			    (apply cfunction constants)
+			    `(combined-method ,name))))
+	    (make-fast-method-call :function function
+				   :arg-info arg-info)))))))
 
 (defmacro call-method-list (&rest calls)
   `(progn ,@calls))
 
 (defun make-call-methods (methods)
   `(call-method-list
-    ,@(mapcar #'(lambda (method) `(call-method ,method ())) methods)))
+    ,@(mapcar (lambda (method) `(call-method ,method ())) methods)))
 
 (defun standard-compute-effective-method (generic-function combin applicable-methods)
   (declare (ignore combin))
@@ -379,22 +379,22 @@
   (standard-compute-effective-method generic-function combin applicable-methods))
 
 (defvar *invalid-method-error*
-	#'(lambda (&rest args)
-	    (declare (ignore args))
-	    (error
-	      "INVALID-METHOD-ERROR was called outside the dynamic scope~%~
-               of a method combination function (inside the body of~%~
-               DEFINE-METHOD-COMBINATION or a method on the generic~%~
-               function COMPUTE-EFFECTIVE-METHOD).")))
+	(lambda (&rest args)
+	  (declare (ignore args))
+	  (error
+	   "INVALID-METHOD-ERROR was called outside the dynamic scope~%~
+            of a method combination function (inside the body of~%~
+            DEFINE-METHOD-COMBINATION or a method on the generic~%~
+            function COMPUTE-EFFECTIVE-METHOD).")))
 
 (defvar *method-combination-error*
-	#'(lambda (&rest args)
-	    (declare (ignore args))
-	    (error
-	      "METHOD-COMBINATION-ERROR was called outside the dynamic scope~%~
-               of a method combination function (inside the body of~%~
-               DEFINE-METHOD-COMBINATION or a method on the generic~%~
-               function COMPUTE-EFFECTIVE-METHOD).")))
+	(lambda (&rest args)
+	  (declare (ignore args))
+	  (error
+	   "METHOD-COMBINATION-ERROR was called outside the dynamic scope~%~
+            of a method combination function (inside the body of~%~
+            DEFINE-METHOD-COMBINATION or a method on the generic~%~
+            function COMPUTE-EFFECTIVE-METHOD).")))
 
 ;This definition appears in defcombin.lisp.
 ;
diff --git a/pcl/construct.lisp b/pcl/construct.lisp
index 78c7756eacaab5ceaaad628849f86e1e604cd1d4..4edbaf6681f7780d65a97e5966b78101fcac8640 100644
--- a/pcl/construct.lisp
+++ b/pcl/construct.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/construct.lisp,v 1.12 1999/05/30 23:13:54 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/construct.lisp,v 1.13 2002/08/26 02:23:11 pmai Exp $")
 ;;;
 ;;; This file defines the defconstructor and other make-instance optimization
 ;;; mechanisms.
@@ -117,10 +117,8 @@
 
 (defun expand-defconstructor (class-name name lambda-list supplied-initargs)
   (let ((class (find-class class-name nil))
-	(supplied-initarg-names
-	  (gathering1 (collecting)
-	    (iterate ((name (*list-elements supplied-initargs :by #'cddr)))
-	      (gather1 name)))))
+	(supplied-initarg-names (loop for name in supplied-initargs by #'cddr
+				      collect name)))
     (when (null class)
       (error "defconstructor form being compiled (or evaluated) before~@
               class ~S is defined."
@@ -241,9 +239,10 @@
             Other possible code types are ~S."
 	  constructor (constructor-class constructor)
 	  (constructor-code-type constructor)
-	  (gathering1 (collecting)
+	  (let ((collected ()))
 	    (doplist (key val) (constructor-code-generators constructor)
-	      (gather1 key)))))
+	      (push key collected))
+	    (nreverse collected))))
 
 ;;;
 ;;; I am not in a hairy enough mood to make this implementation be metacircular
@@ -405,15 +404,14 @@
 	   ((class slot-class)
 	    name lambda-list supplied-initarg-names supplied-initargs)
   (cons 'list
-	(gathering1 (collecting)
-	  (dolist (entry *constructor-code-types*)
-	    (let ((generator
-		    (funcall (cadr entry) class name lambda-list 
-					  supplied-initarg-names
-					  supplied-initargs)))
-	      (when generator
-		(gather1 `',(car entry))
-		(gather1 generator)))))))
+	(loop for (type generator-generator) in *constructor-code-types*
+	      for generator = (funcall generator-generator
+				       class name lambda-list
+				       supplied-initarg-names
+				       supplied-initargs)
+	      when generator
+	        collect `',type
+	        and collect generator)))
 
 (defmethod compute-constructor-code ((class slot-class)
 				     (constructor constructor))
@@ -477,7 +475,7 @@
 		 (funcall fn constructor))
 	       (dolist (subclass (class-direct-subclasses class))
 		 (recurse subclass))))
-      (recurse (find-class 't))
+      (recurse (find-class t))
       (values nclasses nconstructors))))
 
 (defun reset-constructors ()
@@ -488,15 +486,15 @@
 (defun disable-constructors ()
   (multiple-value-bind (nclass ncons)
       (map-constructors
-	#'(lambda (c)
-	    (let ((gen (getf (constructor-code-generators c) 'fallback)))
-	      (if (null gen)
-		  (error "No fallback constructor for ~S." c)
-		  (set-constructor-code c
-					(funcall gen
-						 (constructor-class c)
-						 () () () ())
-					'fallback)))))
+	(lambda (c)
+	  (let ((gen (getf (constructor-code-generators c) 'fallback)))
+	    (if (null gen)
+		(error "No fallback constructor for ~S." c)
+		(set-constructor-code c
+				      (funcall gen
+					       (constructor-class c)
+					       () () () ())
+				      'fallback)))))
     (format t "~&~D classes, ~D constructors." nclass ncons)))
 
 (defun enable-constructors ()
@@ -519,21 +517,21 @@
 		    (list *the-class-slot-object* *the-class-t*)))
 
 (defun non-pcl-initialize-instance-methods-p (methods)
-  (notevery #'(lambda (m) (eq m *standard-initialize-instance-method*))
+  (notevery (lambda (m) (eq m *standard-initialize-instance-method*))
 	    methods))
 
 (defun non-pcl-shared-initialize-methods-p (methods)
-  (notevery #'(lambda (m) (eq m *standard-shared-initialize-method*))
+  (notevery (lambda (m) (eq m *standard-shared-initialize-method*))
 	    methods))
 
 (defun non-pcl-or-after-initialize-instance-methods-p (methods)
-  (notevery #'(lambda (m) (or (eq m *standard-initialize-instance-method*)
-			      (equal '(:after) (method-qualifiers m))))
+  (notevery (lambda (m) (or (eq m *standard-initialize-instance-method*)
+			    (equal '(:after) (method-qualifiers m))))
 	    methods))
 
 (defun non-pcl-or-after-shared-initialize-methods-p (methods)
-  (notevery #'(lambda (m) (or (eq m *standard-shared-initialize-method*)
-			      (equal '(:after) (method-qualifiers m))))
+  (notevery (lambda (m) (or (eq m *standard-shared-initialize-method*)
+			    (equal '(:after) (method-qualifiers m))))
 	    methods))
 
 ;;;
@@ -563,13 +561,13 @@
 	       (push (cons name *slot-unbound*) constants))
 	      ((constantp initform)
 	       (push (cons name (eval initform)) constants)
-	       (when (eq flag ':unsupplied) (setq flag ':constants)))
+	       (when (eq flag :unsupplied) (setq flag :constants)))
 	      (t
 	       (push (cons name *slot-unbound*) constants)
-	       (setq flag 't)))))
-    (let* ((constants-alist (sort constants #'(lambda (x y)
-						(memq (car y)
-						      (memq (car x) layout)))))
+	       (setq flag t)))))
+    (let* ((constants-alist (sort constants (lambda (x y)
+					      (memq (car y)
+						    (memq (car x) layout)))))
 	   (constants-list (mapcar #'cdr constants-alist)))
     (values constants-list flag))))
 
@@ -584,34 +582,30 @@
 ;;;
 (defun compute-initarg-positions (class initarg-names)
   (let* ((layout (wrapper-instance-slots-layout (class-wrapper class)))
-	 (positions
-	   (gathering1 (collecting)
-	     (iterate ((slot-name (list-elements layout))
-		       (position (interval :from 0)))
-	       (gather1 (cons slot-name position)))))
-	 (slot-initargs
-	   (mapcar #'(lambda (slotd)
-		       (list (slot-definition-initargs slotd)
-			     (or (cdr (assq (slot-definition-name slotd) positions))
-				 ':class)))
-		   (class-slots class))))
-    ;; Go through each of the initargs, and figure out what position
-    ;; it fills by replacing the entries in slot-initargs it fills.
+	 (positions (loop for position from 0 and slot-name in layout
+			  collect (cons slot-name position)))
+	 (slot-initargs-positions
+	   (loop for slotd in (class-slots class)
+	         collect
+		 (list (slot-definition-initargs slotd)
+		       (or (cdr (assq (slot-definition-name slotd) positions))
+			   :class)))))
+    ;; Go through each of the initargs, and figure out what position it
+    ;; fills by replacing the entries in slot-initargs-positions it fills.
     (dolist (initarg initarg-names)
-      (dolist (slot-entry slot-initargs)
+      (dolist (slot-entry slot-initargs-positions)
 	(let ((slot-initargs (car slot-entry)))
 	  (when (and (listp slot-initargs)
 		     (not (null slot-initargs))
 		     (memq initarg slot-initargs))
 	    (setf (car slot-entry) initarg)))))
-    (gathering1 (collecting)
-      (dolist (initarg initarg-names)
-	(let ((positions (gathering1 (collecting)
-			   (dolist (slot-entry slot-initargs)
-			     (when (eq (car slot-entry) initarg)
-			       (gather1 (cadr slot-entry)))))))
-	  (when positions
-	    (gather1 (cons initarg positions))))))))
+    ;; Now collect all possible positions for each initarg
+    (loop for initarg in initarg-names
+	  for positions = (loop for (arg position) in slot-initargs-positions
+				when (eq arg initarg)
+				  collect position)
+	  when positions
+	    collect (cons initarg positions))))
 
 
 ;;;
@@ -630,10 +624,10 @@
 	 (kernel:instance-lambda ,arglist
 	   (make-instance
 	     ',(class-name class)
-	     ,@(gathering1 (collecting)
-		 (iterate ((tail (*list-tails supplied-initargs :by #'cddr)))
-		   (gather1 `',(car tail))
-		   (gather1 (cadr tail))))))))))
+	     ,@(loop for (name value) on supplied-initargs by #'cddr
+		     collect `',name
+		     collect value)))))))
+
 
 ;;;
 ;;; The GENERAL case allows:
@@ -686,15 +680,17 @@
 		       (dolist (pos (cddr entry))
 			 (setf (%instance-ref .slots. pos) val))))
 
-		   ,@(gathering1 (collecting)
+		   ,@(let ((collected ()))
 		       (doplist (initarg value) supplied-initargs
 			 (unless (constantp value)
-			   (gather1 `(let ((.value. ,value))
-				       (push .value. .initargs.)
-				       (push ',initarg .initargs.)
-				       (dolist (.p. (pop .positions.))
-					 (setf (%instance-ref .slots. .p.)
-					       .value.)))))))
+			   (push `(let ((.value. ,value))
+				    (push .value. .initargs.)
+				    (push ',initarg .initargs.)
+				    (dolist (.p. (pop .positions.))
+				      (setf (%instance-ref .slots. .p.)
+					    .value.)))
+				 collected)))
+		       (nreverse collected))
 
 		   (dolist (fn .shared-initfns.)
 		     (apply fn .instance. t .initargs.))
@@ -840,14 +836,16 @@
 		     (let ((val (funcall (car entry))))
 		       (dolist (pos (cdr entry))
 			 (setf (%instance-ref .slots. pos) val))))
-		 
-		   ,@(gathering1 (collecting)
+
+		   ,@(let ((collected ()))
 		       (doplist (initarg value) supplied-initargs
 			 (unless (constantp value)
-			   (gather1
-			     `(let ((.value. ,value))
-				(dolist (.p. (pop .positions.))
-				  (setf (%instance-ref .slots. .p.) .value.)))))))
+			   (push `(let ((.value. ,value))
+				     (dolist (.p. (pop .positions.))
+				       (setf (%instance-ref .slots. .p.)
+					     .value.)))
+				 collected)))
+		       (nreverse collected))
 		     
 		   .instance.))))))))
 
@@ -969,14 +967,16 @@
 			  (.slots. (,slots-fetcher .instance.))
 			  (.positions. .supplied-initarg-positions.))
 		     .positions.
-		 
-		     ,@(gathering1 (collecting)
+
+		     ,@(let ((collected ()))
 			 (doplist (initarg value) supplied-initargs
 			   (unless (constantp value)
-			     (gather1
-			       `(let ((.value. ,value))
-				  (dolist (.p. (pop .positions.))
-				    (setf (%instance-ref .slots. .p.) .value.)))))))
+			     (push `(let ((.value. ,value))
+				      (dolist (.p. (pop .positions.))
+					(setf (%instance-ref .slots. .p.)
+					      .value.)))
+				   collected)))
+			 (nreverse collected))
 		     
 		     .instance.))))))))))
 
diff --git a/pcl/cpl.lisp b/pcl/cpl.lisp
index 4690d9d5e6065b60f490710d0b3ab130f0a842f0..5c554791790554e5c0f09988971132da52b5922a 100644
--- a/pcl/cpl.lisp
+++ b/pcl/cpl.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cpl.lisp,v 1.9 1999/05/30 23:13:55 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cpl.lisp,v 1.10 2002/08/26 02:23:11 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -266,21 +266,21 @@
 		 (format nil "named ~S" (class-name class))
 		 class))))
     (mapcar
-      #'(lambda (reason)
-	  (ecase (caddr reason)
-	    (:super
-	      (format
-		nil
-		"the class ~A appears in the supers of the class ~A"
-		(class-or-name (cadr reason))
-		(class-or-name (car reason))))
-	    (:in-supers
-	      (format
-		nil
-		"the class ~A follows the class ~A in the supers of the class ~A"
-		(class-or-name (cadr reason))
-		(class-or-name (car reason))
-		(class-or-name (cadddr reason))))))      
+      (lambda (reason)
+	(ecase (caddr reason)
+	  (:super
+	   (format
+	    nil
+	    "the class ~A appears in the supers of the class ~A"
+	    (class-or-name (cadr reason))
+	    (class-or-name (car reason))))
+	  (:in-supers
+	   (format
+	    nil
+	    "the class ~A follows the class ~A in the supers of the class ~A"
+	    (class-or-name (cadr reason))
+	    (class-or-name (car reason))
+	    (class-or-name (cadddr reason))))))      
       reasons)))
 
 (defun find-cycle-reasons (all-cpds)
diff --git a/pcl/defclass.lisp b/pcl/defclass.lisp
index dcb8163046aaf32a05ad92deee575b7ed9b539e4..09272a5c188ebac11556d44c7ffbcfe9092f3e6f 100644
--- a/pcl/defclass.lisp
+++ b/pcl/defclass.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defclass.lisp,v 1.20 2002/08/13 21:13:58 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defclass.lisp,v 1.21 2002/08/26 02:23:12 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -155,12 +155,12 @@
 	  (*slots* ()))
       (declare (special *initfunctions* *readers* *writers* *slots*))
       (let ((canonical-slots
-	      (mapcar #'(lambda (spec)
-			  (canonicalize-slot-specification name spec))
+	      (mapcar (lambda (spec)
+			(canonicalize-slot-specification name spec))
 		      slots))
 	    (other-initargs
-	      (mapcar #'(lambda (option)
-			  (canonicalize-defclass-option name option))
+	      (mapcar (lambda (option)
+			(canonicalize-defclass-option name option))
 		      options))
 	    (defstruct-p (and (eq *boot-state* 'complete)
 			      (let ((mclass (find-class metaclass nil)))
@@ -171,18 +171,18 @@
                  (make-top-level-form `(defclass ,name)
                    (if defstruct-p '(load eval) *defclass-times*)
 		   `(progn
-		      ,@(mapcar #'(lambda (x)
-				    `(declaim (ftype (function (t) t) ,x)))
+		      ,@(mapcar (lambda (x)
+				  `(declaim (ftype (function (t) t) ,x)))
 				*readers*)
-		      ,@(mapcar #'(lambda (x)
-				    `(declaim (ftype (function (t t) t) ,x)))
+		      ,@(mapcar (lambda (x)
+				  `(declaim (ftype (function (t t) t) ,x)))
 				*writers*)
-		      ,@(mapcar #'(lambda (x)
-		                    `(declaim (ftype (function (t) t)
-				                     ,(slot-reader-symbol x)
-						     ,(slot-boundp-symbol x))
-					      (ftype (function (t t) t)
-					             ,(slot-writer-symbol x))))
+		      ,@(mapcar (lambda (x)
+				  `(declaim (ftype (function (t) t)
+						   ,(slot-reader-symbol x)
+						   ,(slot-boundp-symbol x))
+					    (ftype (function (t t) t)
+						   ,(slot-writer-symbol x))))
 				*slots*)
 		      (let ,(mapcar #'cdr *initfunctions*)
 			(load-defclass ',name
@@ -210,13 +210,13 @@
 
 (defun make-initfunction (initform)
   (declare (special *initfunctions*))
-  (cond ((or (eq initform 't)
+  (cond ((or (eq initform t)
 	     (equal initform ''t))
 	 '(function true))
-	((or (eq initform 'nil)
+	((or (eq initform nil)
 	     (equal initform ''nil))
 	 '(function false))
-	((or (eql initform '0)
+	((or (eql initform 0)
 	     (equal initform ''0))
 	 '(function zero))
 	(t
@@ -344,10 +344,9 @@
     (values (early-collect-slots cpl)
 	    cpl
 	    (early-collect-default-initargs cpl)
-	    (gathering1 (collecting)
-	      (dolist (definition *early-class-definitions*)
-		(when (memq class-name (ecd-superclass-names definition))
-		  (gather1 (ecd-class-name definition))))))))
+	    (loop for definition in *early-class-definitions*
+		  when (memq class-name (ecd-superclass-names definition))
+		    collect (ecd-class-name definition)))))
 
 (defun early-collect-slots (cpl)
   (let* ((definitions (mapcar #'early-class-definition cpl))
diff --git a/pcl/defcombin.lisp b/pcl/defcombin.lisp
index b62c0ff4f5ffcf298f754d57824b78ebb1e4a96c..adaf1b7d2b3ef6ff703d6e0c07fe1274728bd44b 100644
--- a/pcl/defcombin.lisp
+++ b/pcl/defcombin.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defcombin.lisp,v 1.13 2002/08/13 21:15:24 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defcombin.lisp,v 1.14 2002/08/26 02:23:12 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -134,14 +134,14 @@
 	    :qualifiers ()
 	    :specializers specializers
 	    :lambda-list '(generic-function type options)
-	    :function #'(lambda(args nms &rest cm-args)
-			  (declare (ignore nms cm-args))
-			  (apply 
-			   #'(lambda (gf type options)
-			       (declare (ignore gf))
-			       (do-short-method-combination
-				type options operator ioa new-method doc))
-			   args))
+	    :function (lambda(args nms &rest cm-args)
+			(declare (ignore nms cm-args))
+			(apply 
+			 (lambda (gf type options)
+			   (declare (ignore gf))
+			   (do-short-method-combination
+			       type options operator ioa new-method doc))
+			 args))
 	    :definition-source `((define-method-combination ,type) ,truename)))
     (when old-method
       (remove-method #'find-method-combination old-method))
@@ -202,7 +202,7 @@
 	    (if (and (null (cdr primary))
 		     (not (null ioa)))
 		`(call-method ,(car primary) ())
-		`(,operator ,@(mapcar #'(lambda (m) `(call-method ,m ()))
+		`(,operator ,@(mapcar (lambda (m) `(call-method ,m ()))
 				      primary)))))
       (cond ((null primary)
 	     `(error "No ~S methods for the generic function ~S."
@@ -255,16 +255,16 @@
 	     :qualifiers ()
 	     :specializers specializers
 	     :lambda-list '(generic-function type options)
-	     :function #'(lambda (args nms &rest cm-args)
-			   (declare (ignore nms cm-args))
-			   (apply
-			    #'(lambda (generic-function type options)
-				(declare (ignore generic-function))
-				(make-instance 'long-method-combination
-					       :type type
-					       :options options
-					       :documentation doc))
-			    args))
+	     :function (lambda (args nms &rest cm-args)
+			 (declare (ignore nms cm-args))
+			 (apply
+			  (lambda (generic-function type options)
+			    (declare (ignore generic-function))
+			    (make-instance 'long-method-combination
+					   :type type
+					   :options options
+					   :documentation doc))
+			  args))
 	 :definition-source `((define-method-combination ,type)
 			      ,(load-truename)))))
     (setf (gethash type *long-method-combination-functions*) function)
@@ -303,7 +303,7 @@
 
       (when ll
 	(setq wrapped-body
-	      `(apply #'(lambda ,ll ,wrapped-body)
+	      `(apply (lambda ,ll ,wrapped-body)
 		      (method-combination-options .method-combination.))))
 
       (values
@@ -317,19 +317,19 @@
 
 (defun wrap-method-group-specifier-bindings
        (method-group-specifiers declarations real-body)
-  (with-gathering ((names (collecting))
-		   (specializer-caches (collecting))
-		   (cond-clauses (collecting))
-		   (required-checks (collecting))
-		   (order-cleanups (collecting)))
-      (dolist (method-group-specifier method-group-specifiers)
-	(multiple-value-bind (name tests description order required)
-	    (parse-method-group-specifier method-group-specifier)
-	  (declare (ignore description))
-	  (let ((specializer-cache (gensym)))
-	    (gather name names)
-	    (gather specializer-cache specializer-caches)
-	    (gather `((or ,@tests)
+  (let ((names ())
+	(specializer-caches ())
+	(cond-clauses ())
+	(required-checks ())
+	(order-cleanups ()))
+    (dolist (method-group-specifier method-group-specifiers)
+      (multiple-value-bind (name tests description order required)
+	  (parse-method-group-specifier method-group-specifier)
+	(declare (ignore description))
+	(let ((specializer-cache (gensym)))
+	  (push name names)
+	  (push specializer-cache specializer-caches)
+	  (push `((or ,@tests)
 		      (if  (equal ,specializer-cache .specializers.)
 			   (return-from .long-method-combination-function.
 			     '(error "More than one method of type ~S ~
@@ -337,60 +337,57 @@
 				     ',name))
 			   (setq ,specializer-cache .specializers.))
 		      (push .method. ,name))
-		    cond-clauses)
-	    (when required
-	      (gather `(when (null ,name)
-			 (return-from .long-method-combination-function.
-			   '(error "No ~S methods." ',name)))
-		      required-checks))
-	    (loop (unless (and (constantp order)
-			       (neq order (setq order (eval order))))
-		    (return t)))
-	    (gather (cond ((eq order :most-specific-first)
-			   `(setq ,name (nreverse ,name)))
-			  ((eq order :most-specific-last) ())
-			  (t
-			   `(ecase ,order
-			      (:most-specific-first
-				(setq ,name (nreverse ,name)))
-			      (:most-specific-last))))
-		    order-cleanups))))
-   `(let (,@names ,@specializer-caches)
-      ,@declarations
-      (dolist (.method. .applicable-methods.)
-	(let ((.qualifiers. (method-qualifiers .method.))
-	      (.specializers. (method-specializers .method.)))
-	  (progn .qualifiers. .specializers.)
-	  (cond ,@cond-clauses)))
-      ,@required-checks
-      ,@order-cleanups
+		cond-clauses)
+	  (when required
+	    (push `(when (null ,name)
+		     (return-from .long-method-combination-function.
+		       '(error "No ~S methods." ',name)))
+		  required-checks))
+	  (loop (unless (and (constantp order)
+			     (neq order (setq order (eval order))))
+		  (return t)))
+	  (push (cond ((eq order :most-specific-first)
+		       `(setq ,name (nreverse ,name)))
+		      ((eq order :most-specific-last) ())
+		      (t
+		       `(ecase ,order
+			 (:most-specific-first
+			  (setq ,name (nreverse ,name)))
+			 (:most-specific-last))))
+		order-cleanups))))
+    `(let (,@(nreverse names) ,@(nreverse specializer-caches))
+        ,@declarations
+        (dolist (.method. .applicable-methods.)
+	  (let ((.qualifiers. (method-qualifiers .method.))
+		(.specializers. (method-specializers .method.)))
+	    (progn .qualifiers. .specializers.)
+	    (cond ,@(nreverse cond-clauses))))
+      ,@(nreverse required-checks)
+      ,@(nreverse order-cleanups)
       ,@real-body)))
    
 (defun parse-method-group-specifier (method-group-specifier)
   ;;(declare (values name tests description order required))
-  (let* ((name (pop method-group-specifier))
-	 (patterns ())
-	 (tests 
-	   (gathering1 (collecting)
-	     (block collect-tests
-	       (loop
-		 (if (or (null method-group-specifier)
-			 (memq (car method-group-specifier)
-			       '(:description :order :required)))
-		     (return-from collect-tests t)
-		     (let ((pattern (pop method-group-specifier)))
-		       (push pattern patterns)
-		       (gather1 (parse-qualifier-pattern name pattern)))))))))
-    (values name
-	    tests
-	    (getf method-group-specifier :description
-		  (make-default-method-group-description patterns))
-	    (getf method-group-specifier :order :most-specific-first)
-	    (getf method-group-specifier :required nil))))
+  (loop
+     with name = (pop method-group-specifier)
+     for pattern = (pop method-group-specifier)
+     until (null pattern)
+     until (memq pattern '(:description :order :required))
+     collect pattern into patterns
+     collect (parse-qualifier-pattern name pattern) into tests
+     finally
+       (return
+	 (values name
+		 tests
+		 (getf method-group-specifier :description
+		       (make-default-method-group-description
+			(nreverse patterns)))
+		 (getf method-group-specifier :order :most-specific-first)
+		 (getf method-group-specifier :required nil)))))
 
 (defun parse-qualifier-pattern (name pattern)
   (cond ((eq pattern '()) `(null .qualifiers.))
-	((eq pattern '*) 't)
+	((eq pattern '*) t)
 	((symbolp pattern) `(,pattern .qualifiers.))
 	((listp pattern) `(qualifier-check-runtime ',pattern .qualifiers.))
 	(t (error "In the method group specifier ~S,~%~
@@ -432,17 +429,15 @@
 ;;;
 (defun deal-with-arguments-option (wrapped-body arguments-option)
   (let* ((intercept-lambda-list
-	   (gathering1 (collecting)
-	     (dolist (arg arguments-option)
-	       (if (memq arg lambda-list-keywords)
-		   (gather1 arg)
-		   (gather1 (gensym))))))
+	  (loop for arg in arguments-option
+		collect (if (memq arg lambda-list-keywords)
+			    arg
+			    (gensym))))
 	 (intercept-rebindings
-	   (gathering1 (collecting)
-	     (iterate ((arg (list-elements arguments-option))
-		       (int (list-elements intercept-lambda-list)))
-	       (unless (memq arg lambda-list-keywords)
-		 (gather1 `(,arg ',int)))))))
+	  (loop for arg in arguments-option
+		and int in intercept-lambda-list
+		unless (memq arg lambda-list-keywords)
+		  collect `(,arg ',int))))
     ;;
     ;;
     (setf (cadr wrapped-body)
@@ -461,7 +456,7 @@
 		 (append intercept-lambda-list '(&rest .ignore.)))))
 
     `(let ((inner-result. ,wrapped-body))
-       `(apply #'(lambda ,',intercept-lambda-list
+       `(apply (lambda ,',intercept-lambda-list
 		   ,,(when (memq '.ignore. intercept-lambda-list)
 		       ''(declare (ignore .ignore.)))
 		   ,inner-result.)
diff --git a/pcl/defs.lisp b/pcl/defs.lisp
index 80394262f79f4b348694eff8c172883659e8c30a..afe91ee26760c69c796904e696de9c275cca9640 100644
--- a/pcl/defs.lisp
+++ b/pcl/defs.lisp
@@ -148,8 +148,8 @@
 
 ;;; interface
 (defun type-from-specializer (specl)
-  (cond ((eq specl 't)
-	 't)
+  (cond ((eq specl t)
+	 t)
 	((consp specl)
          (unless (member (car specl) '(class prototype class-eq eql))
            (error "~S is not a legal specializer type" specl))
@@ -168,7 +168,7 @@
   (declare (special *the-class-t*))
   (setq type (type-from-specializer type))
   (if (atom type)
-      (if (eq type 't)
+      (if (eq type t)
 	  *the-class-t*
 	  (error "bad argument to type-class"))
       (case (car type)
@@ -199,10 +199,10 @@
 
 (defun make-class-eq-predicate (class)
   (when (symbolp class) (setq class (find-class class)))
-  #'(lambda (object) (eq class (class-of object))))
+  (lambda (object) (eq class (class-of object))))
 
 (defun make-eql-predicate (eql-object)
-  #'(lambda (object) (eql eql-object object)))
+  (lambda (object) (eql eql-object object)))
 
 
 ;;; Internal to this file.
@@ -331,7 +331,7 @@
 (defmacro define-gf-predicate (predicate-name &rest classes)
   `(progn 
      (defmethod ,predicate-name ((x t)) nil)
-     ,@(mapcar #'(lambda (c) `(defmethod ,predicate-name ((x ,c)) t))
+     ,@(mapcar (lambda (c) `(defmethod ,predicate-name ((x ,c)) t))
 	       classes)))
 
 (defun make-class-predicate-name (name)
@@ -416,8 +416,8 @@
 	  (res `(,name
 		 ,(mapcar #'lisp:class-name (direct-supers class))
 		 ,(mapcar #'lisp:class-name (direct-subs class))
-		 ,(map 'list #'(lambda (x)
-				 (lisp:class-name (kernel:layout-class x)))
+		 ,(map 'list (lambda (x)
+			       (lisp:class-name (kernel:layout-class x)))
 		       (reverse
 			(kernel:layout-inherits
 			 (kernel:class-layout class))))
@@ -662,11 +662,11 @@
   ())
 
 (defclass effective-slot-definition (slot-definition)
-  ((reader-function ; #'(lambda (object) ...)
+  ((reader-function ; (lambda (object) ...)
     :accessor slot-definition-reader-function)
-   (writer-function ; #'(lambda (new-value object) ...)
+   (writer-function ; (lambda (new-value object) ...)
     :accessor slot-definition-writer-function)
-   (boundp-function ; #'(lambda (object) ...)
+   (boundp-function ; (lambda (object) ...)
     :accessor slot-definition-boundp-function)
    (accessor-flags
     :initform 0)))
diff --git a/pcl/defsys.lisp b/pcl/defsys.lisp
index 44343e2c4a6b27e9daa5e6346d36070cb44638b3..3f8c49bfb67ecbc464412dd741feb5d37656abca 100644
--- a/pcl/defsys.lisp
+++ b/pcl/defsys.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defsys.lisp,v 1.24 2001/04/10 22:37:21 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defsys.lisp,v 1.25 2002/08/26 02:23:12 pmai Exp $")
 ;;;
 ;;; Some support stuff for compiling and loading PCL.  It would be nice if
 ;;; there was some portable make-system we could all agree to share for a
@@ -57,20 +57,9 @@
 (in-package :user)
 
 (defpackage "WALKER" (:use :common-lisp))
-(defpackage "ITERATE" (:use :common-lisp :walker)(:export "ITERATE"))
-(defpackage "PCL" (:use :walker :iterate :common-lisp))
+(defpackage "PCL" (:use :walker :common-lisp))
 (in-package "PCL")
 
-;;(in-package :walker :use '(:lisp))
-;;(in-package :iterate :use '(:lisp :walker))
-;;(in-package :pcl :use '(:walker :iterate :lisp))
-#+nil
-(export (intern (symbol-name :iterate)		;Have to do this here,
-		(find-package :iterate))	;because in the defsystem
-	(find-package :iterate))		;(later in this file)
-						;we use the symbol iterate
-						;to name the file
-
 ;;;
 ;;; Sure, its weird for this to be here, but in order to follow the rules
 ;;; about order of export and all that stuff, we can't put it in PKG before
@@ -187,7 +176,7 @@ and load your system with:
   (setf (get name 'system-definition) new-value))
 
 (defmacro defsystem (name directory files)
-  `(set-system ',name (list #'(lambda () ,directory)
+  `(set-system ',name (list (lambda () ,directory)
 			    (make-modules ',files)
 			    ',(mapcar #'car files))))
 
@@ -214,13 +203,13 @@ and load your system with:
                    (progn (setq modules (cons (make-module name) modules))
                           (car modules))))
              (parse-spec (spec)
-               (if (eq spec 't)
+               (if (eq spec t)
                    (reverse (cdr modules))
 		   (case (car spec)
 		     (+ (append (reverse (cdr modules))
 				(mapcar #'get-module (cdr spec))))
 		     (- (let ((rem (mapcar #'get-module (cdr spec))))
-			  (remove-if #'(lambda (m) (member m rem))
+			  (remove-if (lambda (m) (member m rem))
 				     (reverse (cdr modules)))))
 		     (otherwise (mapcar #'get-module spec))))))
       (dolist (file system-description)
@@ -234,8 +223,8 @@ and load your system with:
                   (module-comp-env module) (parse-spec (caddr file))
                   (module-recomp-reasons module) (parse-spec (cadddr file))))))
       (let ((filenames (mapcar #'car system-description)))
-	(sort modules #'(lambda (name1 name2)
-			  (member name2 (member name1 filenames)))
+	(sort modules (lambda (name1 name2)
+			(member name2 (member name1 filenames)))
 	      :key #'module-name)))))
 
 
@@ -248,13 +237,13 @@ and load your system with:
 
 (defun make-compile-transformation (module transforms)
   (unless (dolist (trans transforms)
-	    (and (eq (car trans) ':compile)
+	    (and (eq (car trans) :compile)
 		 (eq (cadr trans) module)
 		 (return t)))
     (dolist (c (module-comp-env module)) (make-load-transformation c transforms))
     (setf (cdr transforms)
-	  (remove-if #'(lambda (trans) (and (eq (car trans) :load)
-					    (eq (cadr trans) module)))
+	  (remove-if (lambda (trans) (and (eq (car trans) :load)
+					  (eq (cadr trans) module)))
 		     (cdr transforms)))
     (push `(:compile ,module) (cdr transforms))))
 
@@ -266,7 +255,7 @@ and load your system with:
       (let ((*being-loaded* (cons (cons module (cdr transforms)) *being-loaded*)))
 	(catch module
 	  (unless (dolist (trans transforms)
-		    (when (and (eq (car trans) ':load)
+		    (when (and (eq (car trans) :load)
 			       (eq (cadr trans) module))
 		      (return t)))
 	    (dolist (l (module-load-env module))
@@ -275,7 +264,7 @@ and load your system with:
 
 (defun make-load-without-dependencies-transformation (module transforms)
   (unless (dolist (trans transforms)
-            (and (eq (car trans) ':load)
+            (and (eq (car trans) :load)
                  (eq (cadr trans) module)
                  (return trans)))
     (push `(:load ,module) (cdr transforms))))
@@ -283,7 +272,7 @@ and load your system with:
 (defun compile-filter (module transforms)
   (or (dolist (r (module-recomp-reasons module))
         (when (dolist (transform transforms)
-                (when (and (eq (car transform) ':compile)
+                (when (and (eq (car transform) :compile)
                            (eq (cadr transform) r))
                   (return t)))
           (return t)))
@@ -317,9 +306,9 @@ and load your system with:
 	  ;; been recompiled.
 	  (make-transformations
 	   modules
-	   #'(lambda (m transforms)
-	       (or (member (module-name m) arg)
-		   (compile-filter m transforms)))
+	   (lambda (m transforms)
+	     (or (member (module-name m) arg)
+		 (compile-filter m transforms)))
 	   #'make-compile-transformation))
 	(:query-compile
 	  ;; Ask the user which files to compile.  Compile those
@@ -327,20 +316,20 @@ and load your system with:
 	  ;; another file has been recompiled.
 	  (make-transformations
 	   modules
-	   #'(lambda (m transforms)
-	       (or (compile-filter m transforms)
-		   (y-or-n-p "Compile ~A?"
-			     (module-name m))))
+	   (lambda (m transforms)
+	     (or (compile-filter m transforms)
+		 (y-or-n-p "Compile ~A?"
+			   (module-name m))))
 	   #'make-compile-transformation))
 	(:confirm-compile
 	  ;; Offer the user a chance to prevent a file from being
 	  ;; recompiled.
 	  (make-transformations
 	   modules
-	   #'(lambda (m transforms)
-	       (and (compile-filter m transforms)
-		    (y-or-n-p "Go ahead and compile ~A?"
-			      (module-name m))))
+	   (lambda (m transforms)
+	     (and (compile-filter m transforms)
+		  (y-or-n-p "Go ahead and compile ~A?"
+			    (module-name m))))
 	   #'make-compile-transformation))
 	(:load
 	  ;; Load the whole system.
@@ -352,16 +341,16 @@ and load your system with:
 	  ;; Load only those files the user says to load.
 	  (make-transformations
 	   modules
-	   #'(lambda (m transforms)
-	       (declare (ignore transforms))
-	       (y-or-n-p "Load ~A?" (module-name m)))
+	   (lambda (m transforms)
+	     (declare (ignore transforms))
+	     (y-or-n-p "Load ~A?" (module-name m)))
 	   #'make-load-without-dependencies-transformation))))))
 
 (defun true (&rest ignore)
   (declare (ignore ignore))
-  't)
+  t)
 
-(defparameter *byte-files* '(defclass defcombin iterate env))
+(defparameter *byte-files* '(defclass defcombin env))
 
 (defun operate-on-system (name mode &optional arg print-only)
   (let ((system (get-system name)))
@@ -425,8 +414,8 @@ and load your system with:
     (unless system (error "Can't find system with name ~S." name))
     (let ((*system-directory* (funcall (the function (car system))))
 	  (modules (cadr system)))
-      (mapcar #'(lambda (module)
-		  (make-source-pathname (module-name module)))
+      (mapcar (lambda (module)
+		(make-source-pathname (module-name module)))
 	      modules))))
 
 (defun system-binary-files (name)
@@ -434,8 +423,8 @@ and load your system with:
     (unless system (error "Can't find system with name ~S." name))
     (let ((*system-directory* (funcall (the function (car system))))
 	  (modules (cadr system)))
-      (mapcar #'(lambda (module)
-		  (make-binary-pathname (module-name module)))
+      (mapcar (lambda (module)
+		(make-binary-pathname (module-name module)))
 	      modules))))
 
 ;;; ***                SITE SPECIFIC PCL DIRECTORY                        ***
@@ -475,13 +464,12 @@ and load your system with:
   (
    (pkg             t            t            ())
    (walk            (pkg)        (pkg)        ())
-   (iterate         t            t            ())
    (macros          t            t            ())
    (low             (pkg macros) t            (macros))
    
    (fin         t                                   t (low))
    (defclass    t                                   t (low))
-   (defs        t                                   t (defclass macros iterate))
+   (defs        t                                   t (defclass macros))
    (fngen       t                                   t (low))
    (cache       t                                   t (low defs))
    (dlisp       t                                   t (defs low fin cache))
@@ -535,7 +523,7 @@ and load your system with:
 	 (operate-on-system 'pcl :query-compile))
 	((eq m :confirm)
 	 (operate-on-system 'pcl :confirm-compile))
-	((eq m 't)
+	((eq m t)
 	 (operate-on-system 'pcl :recompile)
 	 (operate-on-system 'gray-streams :recompile))
 	((listp m)
@@ -588,13 +576,13 @@ and load your system with:
 	  (fmakunbound sym)
 	  (setf (symbol-plist sym) nil))))
     (let ((pcl (find-package "PCL")))
-      (mapcar #'(lambda (name value)
-		  (let ((var (intern name pcl)))
-		    (proclaim `(special ,var))
-		    (set var value)))
+      (mapcar (lambda (name value)
+		(let ((var (intern name pcl)))
+		  (proclaim `(special ,var))
+		  (set var value)))
 	      names values))      
     (dolist (sym *redefined-functions*)
-      (setf (symbol-function sym) (get sym ':definition-before-pcl)))
+      (setf (symbol-function sym) (get sym :definition-before-pcl)))
     nil))
 
 (defun reset-package (&optional (package-name "PCL"))
diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp
index f08117fe9500e38ede1a825a826a8f96568119e8..d58f920bd274c60ee6b80a3c2131d16ef913339a 100644
--- a/pcl/dfun.lisp
+++ b/pcl/dfun.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.13 2001/10/30 22:50:58 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.14 2002/08/26 02:23:12 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -115,10 +115,10 @@ And so, we are saved.
   (when (and *raise-metatypes-to-class-p*
 	     (member generator '(emit-checking emit-caching
 				 emit-in-checking-cache-p emit-constant-value)))
-    (setq args (cons (mapcar #'(lambda (mt)
-				 (if (eq mt 't)
-				     mt
-				     'class))
+    (setq args (cons (mapcar (lambda (mt)
+			       (if (eq mt t)
+				   mt
+				   'class))
 			     (car args))
 		     (cdr args))))						  
   (let* ((generator-entry (assq generator *dfun-constructors*))
@@ -166,13 +166,15 @@ And so, we are saved.
 (defmacro precompile-dfun-constructors (&optional system)
   (let ((*precompiling-lap* t))
     `(progn
-       ,@(gathering1 (collecting)
-	   (dolist (generator-entry *dfun-constructors*)
+       ,@(let ((collected ()))
+	   (dolist (generator-entry *dfun-constructors*
+		    (nreverse collected))
 	     (dolist (args-entry (cdr generator-entry))
 	       (when (or (null (caddr args-entry))
 			 (eq (caddr args-entry) system))
-		 (when system (setf (caddr args-entry) system))
-		 (gather1
+		 (when system
+		   (setf (caddr args-entry) system))
+		 (push
 		   (make-top-level-form `(precompile-dfun-constructor 
 					  ,(car generator-entry))
 					'(load)
@@ -181,7 +183,8 @@ And so, we are saved.
 		       ',(car args-entry)
 		       ',system
 		       ,(apply (symbol-function (car generator-entry))
-			       (car args-entry))))))))))))
+			       (car args-entry))))
+		   collected))))))))
 
 
 ;;;
@@ -322,13 +325,13 @@ And so, we are saved.
 (defun accessor-miss-function (gf dfun-info)
   (ecase (dfun-info-accessor-type dfun-info)
     (reader
-      #'(lambda (arg)
-	   (declare (pcl-fast-call))
-	   (accessor-miss gf nil arg dfun-info)))
+     (lambda (arg)
+       (declare (pcl-fast-call))
+       (accessor-miss gf nil arg dfun-info)))
     (writer
-     #'(lambda (new arg)
-	 (declare (pcl-fast-call))
-	 (accessor-miss gf new arg dfun-info)))))
+     (lambda (new arg)
+       (declare (pcl-fast-call))
+       (accessor-miss gf new arg dfun-info)))))
 
 (declaim (ext:freeze-type dfun-info))
 
@@ -411,7 +414,7 @@ And so, we are saved.
   (multiple-value-bind (nreq applyp metatypes nkeys)
       (get-generic-function-info generic-function)
     (declare (ignore nreq))
-    (if (every #'(lambda (mt) (eq mt 't)) metatypes)
+    (if (every (lambda (mt) (eq mt t)) metatypes)
 	(let ((dfun-info (default-method-only-dfun-info)))
 	  (values 
 	   (funcall (get-dfun-constructor 'emit-default-only metatypes applyp)
@@ -424,20 +427,20 @@ And so, we are saved.
 	   (funcall (get-dfun-constructor 'emit-checking metatypes applyp)
 		    cache
 		    function 
-		    #'(lambda (&rest args)
-			(declare (pcl-fast-call))
-			#+copy-&rest-arg (setq args (copy-list args))
-			(checking-miss generic-function args dfun-info)))
+		    (lambda (&rest args)
+		      (declare (pcl-fast-call))
+		      #+copy-&rest-arg (setq args (copy-list args))
+		      (checking-miss generic-function args dfun-info)))
 	   cache
 	   dfun-info)))))
 
 (defun make-final-checking-dfun (generic-function function
 						  classes-list new-class)
   (let ((metatypes (arg-info-metatypes (gf-arg-info generic-function))))
-    (if (every #'(lambda (mt) (eq mt 't)) metatypes)
-	(values #'(lambda (&rest args)
-		    #+copy-&rest-arg (setq args (copy-list args))
-		    (invoke-emf function args))
+    (if (every (lambda (mt) (eq mt t)) metatypes)
+	(values (lambda (&rest args)
+		  #+copy-&rest-arg (setq args (copy-list args))
+		  (invoke-emf function args))
 		nil (default-method-only-dfun-info))
 	(let ((cache (make-final-ordinary-dfun-internal 
 		      generic-function nil #'checking-limit-fn 
@@ -448,14 +451,14 @@ And so, we are saved.
   (multiple-value-bind (nreq applyp metatypes nkeys)
       (get-generic-function-info generic-function)
     (declare (ignore nreq applyp nkeys))
-    (every #'(lambda (mt) (eq mt 't)) metatypes)))
+    (every (lambda (mt) (eq mt t)) metatypes)))
 
 (defun use-caching-dfun-p (generic-function)
-  (some #'(lambda (method)
-	    (let ((fmf (if (listp method)
-			   (third method)
-			   (method-fast-function method))))
-	      (method-function-get fmf ':slot-name-lists)))
+  (some (lambda (method)
+	  (let ((fmf (if (listp method)
+			 (third method)
+			 (method-fast-function method))))
+	    (method-function-get fmf :slot-name-lists)))
 	(if (early-gf-p generic-function)
 	    (early-gf-methods generic-function)
 	    (generic-function-methods generic-function))))
@@ -481,10 +484,10 @@ And so, we are saved.
       (values
        (funcall (get-dfun-constructor 'emit-caching metatypes applyp)
 		cache
-		#'(lambda (&rest args)
-		    (declare (pcl-fast-call))
-		    #+copy-&rest-arg (setq args (copy-list args))
-		    (caching-miss generic-function args dfun-info)))
+		(lambda (&rest args)
+		  (declare (pcl-fast-call))
+		  #+copy-&rest-arg (setq args (copy-list args))
+		  (caching-miss generic-function args dfun-info)))
        cache
        dfun-info))))
 
@@ -504,7 +507,7 @@ And so, we are saved.
     (when (and metatypes
 	       (not (null (car metatypes)))
 	       (dolist (mt metatypes nil)
-		 (unless (eq mt 't) (return t))))
+		 (unless (eq mt t) (return t))))
       (get-dfun-constructor 'emit-caching metatypes applyp))))
 
 (defun use-constant-value-dfun-p (gf &optional boolean-values-p)
@@ -519,19 +522,19 @@ And so, we are saved.
       (and (null applyp)
 	   (or (not (eq *boot-state* 'complete))
 	       (compute-applicable-methods-emf-std-p gf))
-	   (notany #'(lambda (method)
-		       (or (and (eq *boot-state* 'complete)
-				(some #'eql-specializer-p
-				      (method-specializers method)))
-			   (let ((value (method-function-get 
-					 (if early-p
-					     (or (third method) (second method))
-					     (or (method-fast-function method)
-						 (method-function method)))
-					 :constant-value default)))
-			     (if boolean-values-p
-				 (not (or (eq value 't) (eq value nil)))
-				 (eq value default)))))
+	   (notany (lambda (method)
+		     (or (and (eq *boot-state* 'complete)
+			      (some #'eql-specializer-p
+				    (method-specializers method)))
+			 (let ((value (method-function-get 
+				       (if early-p
+					   (or (third method) (second method))
+					   (or (method-fast-function method)
+					       (method-function method)))
+				       :constant-value default)))
+			   (if boolean-values-p
+			       (not (or (eq value t) (eq value nil)))
+			       (eq value default)))))
 		   methods)))))
 
 (defun make-constant-value-dfun (generic-function &optional cache)
@@ -543,10 +546,10 @@ And so, we are saved.
       (values
        (funcall (get-dfun-constructor 'emit-constant-value metatypes)
 		cache
-		#'(lambda (&rest args)
-		    (declare (pcl-fast-call))
-		    #+copy-&rest-arg (setq args (copy-list args))
-		    (constant-value-miss generic-function args dfun-info)))
+		(lambda (&rest args)
+		  (declare (pcl-fast-call))
+		  #+copy-&rest-arg (setq args (copy-list args))
+		  (constant-value-miss generic-function args dfun-info)))
        cache
        dfun-info))))
 
@@ -595,21 +598,21 @@ And so, we are saved.
 (defun dispatch-dfun-cost (gf)
   (generate-discrimination-net-internal 
    gf (generic-function-methods gf) nil
-   #'(lambda (methods known-types)
-       (declare (ignore methods known-types))
-       0)
-   #'(lambda (position type true-value false-value)
-       (declare (ignore position))
-       (+ (max true-value false-value)
-	  (if (eq 'class (car type))
-	      (let ((cpl (class-precedence-list (class-of (cadr type)))))
-		(cond((memq *the-class-built-in-class* cpl)
-		      *built-in-typep-cost*)
-		     ((memq *the-class-structure-class* cpl)
-		      *structure-typep-cost*)
-		     (t
-		      *non-built-in-typep-cost*)))
-	      0)))
+   (lambda (methods known-types)
+     (declare (ignore methods known-types))
+     0)
+   (lambda (position type true-value false-value)
+     (declare (ignore position))
+     (+ (max true-value false-value)
+	(if (eq 'class (car type))
+	    (let ((cpl (class-precedence-list (class-of (cadr type)))))
+	      (cond((memq *the-class-built-in-class* cpl)
+		    *built-in-typep-cost*)
+		   ((memq *the-class-structure-class* cpl)
+		    *structure-typep-cost*)
+		   (t
+		    *non-built-in-typep-cost*)))
+	    0)))
    #'identity))
 
 ;; This version is from the pcl found in the gcl-2.1 distribution.
@@ -617,27 +620,27 @@ And so, we are saved.
 (defun dispatch-dfun-cost (gf &optional limit)
   (generate-discrimination-net-internal 
    gf (generic-function-methods gf) nil
-   #'(lambda (methods known-types)
-       (declare (ignore methods known-types))
-       0)
-   #'(lambda (position type true-value false-value)
-       (declare (ignore position))
-       (let* ((type-test-cost
-	       (if (eq 'class (car type))
-		   (let* ((metaclass (class-of (cadr type)))
-			  (mcpl (class-precedence-list metaclass)))
-		     (cond ((memq *the-class-built-in-class* mcpl)
-			    *built-in-typep-cost*)
-			   ((memq *the-class-structure-class* mcpl)
-			    *structure-typep-cost*)
-			   (t
-			    *non-built-in-typep-cost*)))
-		   0))
-	      (max-cost-so-far
-	       (+ (max true-value false-value) type-test-cost)))
-	 (when (and limit (<= limit max-cost-so-far))
-	   (return-from dispatch-dfun-cost max-cost-so-far))
-	   max-cost-so-far))
+   (lambda (methods known-types)
+     (declare (ignore methods known-types))
+     0)
+   (lambda (position type true-value false-value)
+     (declare (ignore position))
+     (let* ((type-test-cost
+	     (if (eq 'class (car type))
+		 (let* ((metaclass (class-of (cadr type)))
+			(mcpl (class-precedence-list metaclass)))
+		   (cond ((memq *the-class-built-in-class* mcpl)
+			  *built-in-typep-cost*)
+			 ((memq *the-class-structure-class* mcpl)
+			  *structure-typep-cost*)
+			 (t
+			  *non-built-in-typep-cost*)))
+		 0))
+	    (max-cost-so-far
+	     (+ (max true-value false-value) type-test-cost)))
+       (when (and limit (<= limit max-cost-so-far))
+	 (return-from dispatch-dfun-cost max-cost-so-far))
+       max-cost-so-far))
    #'identity))
 
 
@@ -683,11 +686,11 @@ And so, we are saved.
 (defun fill-dfun-cache (table valuep nkeys limit-fn &optional cache)
   (let ((cache (or cache (get-cache nkeys valuep limit-fn
 				    (+ (hash-table-count table) 3)))))
-    (maphash #'(lambda (classes value)
-		 (setq cache (fill-cache cache
-					 (class-wrapper classes)
-					 value
-					 t)))
+    (maphash (lambda (classes value)
+	       (setq cache (fill-cache cache
+				       (class-wrapper classes)
+				       value
+				       t)))
 	     table)
     cache))
 
@@ -824,18 +827,18 @@ And so, we are saved.
   (let ((methods (if (early-gf-p gf)
 		     (early-gf-methods gf)
 		     (generic-function-methods gf))))
-    (cond ((every #'(lambda (method) 
-		      (if (consp method)
-			  (eq *the-class-standard-reader-method*
-			      (early-method-class method))
-			  (standard-reader-method-p method)))
+    (cond ((every (lambda (method) 
+		    (if (consp method)
+			(eq *the-class-standard-reader-method*
+			    (early-method-class method))
+			(standard-reader-method-p method)))
 		  methods)
 	   'reader)
-	  ((every #'(lambda (method) 
-		      (if (consp method)
-			  (eq *the-class-standard-writer-method*
-			      (early-method-class method))
-			  (standard-writer-method-p method)))
+	  ((every (lambda (method) 
+		    (if (consp method)
+			(eq *the-class-standard-writer-method*
+			    (early-method-class method))
+			(standard-writer-method-p method)))
 		  methods)
 	   'writer))))
 
@@ -872,12 +875,12 @@ And so, we are saved.
 	    (no-methods-dfun-info)))
 	  ((setq type (final-accessor-dfun-type gf))
 	   (make-final-accessor-dfun gf type classes-list new-class))
-	  ((and (not (and (every #'(lambda (specl) (eq specl *the-class-t*))
+	  ((and (not (and (every (lambda (specl) (eq specl *the-class-t*))
 				 (setq specls (method-specializers (car methods))))
 			  (setq all-same-p
-				(every #'(lambda (method)
-					   (and (equal specls
-						       (method-specializers method))))
+				(every (lambda (method)
+					 (and (equal specls
+						     (method-specializers method))))
 				       methods))))
 		(use-constant-value-dfun-p gf))
 	   (make-final-constant-value-dfun gf classes-list new-class))
@@ -948,8 +951,8 @@ And so, we are saved.
 		  (setq oindex (dfun-info-index dfun-info))
 		  (setq cache (dfun-info-cache dfun-info))
 		  (if (eql nindex oindex)
-		      (do-fill #'(lambda (ncache)
-				   (one-index nindex ncache)))
+		      (do-fill (lambda (ncache)
+				 (one-index nindex ncache)))
 		      (n-n)))
 		 (n-n
 		  (setq cache (dfun-info-cache dfun-info))
@@ -1143,39 +1146,39 @@ And so, we are saved.
 	(when (or (null specl-cpl)
 		  (member *the-class-structure-object* specl-cpl))
 	  (return-from make-accessor-table nil))
-	(maphash #'(lambda (class slotd)
-		     (let ((cpl (if early-p
-				    (early-class-precedence-list class)
-				    (class-precedence-list class))))
-		       (when (memq specl cpl)
-			 (unless (and (or so-p
-					  (member *the-class-std-object* cpl))
-				      (or early-p
-					  (slot-accessor-std-p slotd type)))
-			   (return-from make-accessor-table nil))
-			 (push (cons specl slotd) (gethash class table)))))
+	(maphash (lambda (class slotd)
+		   (let ((cpl (if early-p
+				  (early-class-precedence-list class)
+				  (class-precedence-list class))))
+		     (when (memq specl cpl)
+		       (unless (and (or so-p
+					(member *the-class-std-object* cpl))
+				    (or early-p
+					(slot-accessor-std-p slotd type)))
+			 (return-from make-accessor-table nil))
+		       (push (cons specl slotd) (gethash class table)))))
 		 (gethash slot-name *name->class->slotd-table*))))
-    (maphash #'(lambda (class specl+slotd-list)
-		 (dolist (sclass (if early-p
-				    (early-class-precedence-list class)
-				    (class-precedence-list class)) 
-			  (error "This can't happen"))
-		   (let ((a (assq sclass specl+slotd-list)))
-		     (when a
-		       (let* ((slotd (cdr a))
-			      (index (if early-p
-					 (early-slot-definition-location slotd) 
-					 (slot-definition-location slotd))))
-			 (unless index (return-from make-accessor-table nil))
-			 (setf (gethash class table) index)
-			 (when (consp index) (setq no-class-slots-p nil))
-			 (setq all-index (if (or (null all-index)
-						 (eql all-index index))
-					     index t))
-			 (incf size)
-			 (cond ((= size 1) (setq first class))
-			       ((= size 2) (setq second class)))
-			 (return nil))))))
+    (maphash (lambda (class specl+slotd-list)
+	       (dolist (sclass (if early-p
+				   (early-class-precedence-list class)
+				   (class-precedence-list class)) 
+			(error "This can't happen"))
+		 (let ((a (assq sclass specl+slotd-list)))
+		   (when a
+		     (let* ((slotd (cdr a))
+			    (index (if early-p
+				       (early-slot-definition-location slotd) 
+				       (slot-definition-location slotd))))
+		       (unless index (return-from make-accessor-table nil))
+		       (setf (gethash class table) index)
+		       (when (consp index) (setq no-class-slots-p nil))
+		       (setq all-index (if (or (null all-index)
+					       (eql all-index index))
+					   index t))
+		       (incf size)
+		       (cond ((= size 1) (setq first class))
+			     ((= size 2) (setq second class)))
+		       (return nil))))))
 	     table)
     (values table all-index first second size no-class-slots-p)))
 
@@ -1211,13 +1214,13 @@ And so, we are saved.
 (defun sort-applicable-methods (precedence methods types)
   (sort-methods methods
 		precedence
-		#'(lambda (class1 class2 index)
-		    (let* ((class (type-class (nth index types)))
-			   (cpl (if (eq *boot-state* 'complete)
-				    (class-precedence-list class)
-				    (early-class-precedence-list class))))
-		      (if (memq class2 (memq class1 cpl))
-			  class1 class2)))))
+		(lambda (class1 class2 index)
+		  (let* ((class (type-class (nth index types)))
+			 (cpl (if (eq *boot-state* 'complete)
+				  (class-precedence-list class)
+				  (early-class-precedence-list class))))
+		    (if (memq class2 (memq class1 cpl))
+			class1 class2)))))
 
 (defun sort-methods (methods precedence compare-classes-function)
   (flet ((sorter (method1 method2)
@@ -1310,7 +1313,7 @@ And so, we are saved.
 (defun compute-precedence (lambda-list nreq argument-precedence-order)
   (if (null argument-precedence-order)
       (let ((list nil))(dotimes (i nreq list) (push (- (1- nreq) i) list)))
-      (mapcar #'(lambda (x) (position x lambda-list)) argument-precedence-order)))
+      (mapcar (lambda (x) (position x lambda-list)) argument-precedence-order)))
 
 (defun saut-and (specl type)
   (let ((applicable nil)
@@ -1416,11 +1419,11 @@ And so, we are saved.
 
 (defun specializer-applicable-using-type-p (specl type)
   (setq specl (type-from-specializer specl))
-  (when (eq specl 't)
+  (when (eq specl t)
     (return-from specializer-applicable-using-type-p (values t t)))
   ;; This is used by c-a-m-u-t and generate-discrimination-net-internal,
   ;; and has only what they need.
-  (if (or (atom type) (eq (car type) 't))
+  (if (or (atom type) (eq (car type) t))
       (values nil t)
       (case (car type)
 	(and        (saut-and specl type))
@@ -1432,7 +1435,7 @@ And so, we are saved.
 	(t          (error "~s cannot handle the second argument ~s"
 			   'specializer-applicable-using-type-p type)))))
 
-(defun map-all-classes (function &optional (root 't))
+(defun map-all-classes (function &optional (root t))
   (let ((braid-p (or (eq *boot-state* 'braid)
 		     (eq *boot-state* 'complete))))
     (labels ((do-class (class)
@@ -1472,14 +1475,14 @@ And so, we are saved.
 					    (all-sorted-p t) function-p)
   (if (null methods)
       (if function-p
-          #'(lambda (method-alist wrappers)
-	      (declare (ignore method-alist wrappers))
-	      #'(kernel:instance-lambda (&rest args)
-	          (apply #'no-applicable-method gf args)))
-	  #'(lambda (method-alist wrappers)
-	      (declare (ignore method-alist wrappers))
-	      #'(lambda (&rest args)
-		  (apply #'no-applicable-method gf args))))
+          (lambda (method-alist wrappers)
+	    (declare (ignore method-alist wrappers))
+	    #'(kernel:instance-lambda (&rest args)
+                (apply #'no-applicable-method gf args)))
+	  (lambda (method-alist wrappers)
+	    (declare (ignore method-alist wrappers))
+	    (lambda (&rest args)
+	      (apply #'no-applicable-method gf args))))
       (let* ((key (car methods))
 	     (ht-value (or (gethash key *effective-method-table*)
 			   (setf (gethash key *effective-method-table*)
@@ -1599,26 +1602,26 @@ And so, we are saved.
 	(incf (cdr b))))))
 
 (defun count-all-dfuns ()
-  (setq dfun-count (mapcar #'(lambda (type) (list type 0 nil))
+  (setq dfun-count (mapcar (lambda (type) (list type 0 nil))
 			   '(ONE-CLASS TWO-CLASS DEFAULT-METHOD-ONLY
 			     ONE-INDEX N-N CHECKING CACHING 
 			     DISPATCH)))
   (map-all-generic-functions #'count-dfun)
-  (mapc #'(lambda (type+count+sizes)
-	    (setf (third type+count+sizes)
-		  (sort (third type+count+sizes) #'< :key #'car)))
+  (mapc (lambda (type+count+sizes)
+	  (setf (third type+count+sizes)
+		(sort (third type+count+sizes) #'< :key #'car)))
 	dfun-count)
-  (mapc #'(lambda (type+count+sizes)
-	    (format t "~&There are ~4d dfuns of type ~s"
-		    (cadr type+count+sizes) (car type+count+sizes))
-	    (format t "~%   ~S~%" (caddr type+count+sizes)))
+  (mapc (lambda (type+count+sizes)
+	  (format t "~&There are ~4d dfuns of type ~s"
+		  (cadr type+count+sizes) (car type+count+sizes))
+	  (format t "~%   ~S~%" (caddr type+count+sizes)))
 	dfun-count)
   (values))
 
 (defun gfs-of-type (type)
   (unless (consp type) (setq type (list type)))
   (let ((gf-list nil))
-    (map-all-generic-functions #'(lambda (gf)
-				   (when (memq (type-of (gf-dfun-info gf)) type)
-				     (push gf gf-list))))
+    (map-all-generic-functions (lambda (gf)
+				 (when (memq (type-of (gf-dfun-info gf)) type)
+				   (push gf gf-list))))
     gf-list))
diff --git a/pcl/dlisp.lisp b/pcl/dlisp.lisp
index fd203dabb124904e18e7f5ec17284af1b74b8729..98b71584835817aee5d4a4440f140394851c73ea 100644
--- a/pcl/dlisp.lisp
+++ b/pcl/dlisp.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp.lisp,v 1.7 1999/05/30 23:13:58 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp.lisp,v 1.8 2002/08/26 02:23:13 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -257,13 +257,13 @@
 
 (defun emit-dlap (args metatypes hit miss value-reg &optional slot-regs)
   (let* ((index -1)
-	 (wrapper-bindings (mapcan #'(lambda (arg mt)
-				       (unless (eq mt 't)
-					 (incf index)
-					 `((,(intern (format nil "WRAPPER-~D" index)
-					             *the-pcl-package*)
-					    ,(emit-fetch-wrapper mt arg 'miss
-					      (pop slot-regs))))))
+	 (wrapper-bindings (mapcan (lambda (arg mt)
+				     (unless (eq mt t)
+				       (incf index)
+				       `((,(intern (format nil "WRAPPER-~D" index)
+						   *the-pcl-package*)
+					  ,(emit-fetch-wrapper mt arg 'miss
+							       (pop slot-regs))))))
 				   args metatypes))
 	 (wrappers (mapcar #'car wrapper-bindings)))
     (declare (fixnum index))
@@ -345,11 +345,11 @@
 	   (block search
 	     (loop (setq next-location (the fixnum (+ location ,cache-line-size)))
 		   (when (and ,@(mapcar
-				 #'(lambda (wrapper)
-				     `(eq ,wrapper 
-				       (cache-vector-ref cache-vector
-					(setq location
-					 (the fixnum (+ location 1))))))
+				 (lambda (wrapper)
+				   `(eq ,wrapper 
+				     (cache-vector-ref cache-vector
+				      (setq location
+				       (the fixnum (+ location 1))))))
 				 wrappers))
 		     ,@(when value
 			 `((setq location (the fixnum (+ location 1)))
@@ -361,8 +361,8 @@
 		   (when (= location primary)
 		     (dolist (entry overflow)
 		       (let ((entry-wrappers (car entry)))
-			 (when (and ,@(mapcar #'(lambda (wrapper)
-						  `(eq ,wrapper (pop entry-wrappers)))
+			 (when (and ,@(mapcar (lambda (wrapper)
+						`(eq ,wrapper (pop entry-wrappers)))
 					      wrappers))
 			   ,@(when value
 			       `((setq ,value (cdr entry))))
@@ -386,19 +386,19 @@
   `(progn
      ,@(let ((adds 0) (len (length wrappers)))
 	 (declare (fixnum adds len))
-	 (mapcar #'(lambda (wrapper)
-		     `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref 
-					       ,wrapper field)))
-		        (declare (fixnum wrapper-cache-no))
-		        (when (zerop wrapper-cache-no) (go ,miss-label))
-		        (setq primary (the fixnum (+ primary wrapper-cache-no)))
-		        ,@(progn
-			    (incf adds)
-			    (when (or (zerop (mod adds wrapper-cache-number-adds-ok))
-				      (eql adds len))
-			      `((setq primary
-				      ,(let ((form `(logand primary mask)))
-					 `(the fixnum ,form))))))))
+	 (mapcar (lambda (wrapper)
+		   `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref 
+					     ,wrapper field)))
+		     (declare (fixnum wrapper-cache-no))
+		     (when (zerop wrapper-cache-no) (go ,miss-label))
+		     (setq primary (the fixnum (+ primary wrapper-cache-no)))
+		     ,@(progn
+			(incf adds)
+			(when (or (zerop (mod adds wrapper-cache-number-adds-ok))
+				  (eql adds len))
+			  `((setq primary
+			     ,(let ((form `(logand primary mask)))
+				   `(the fixnum ,form))))))))
 		 wrappers))))
      
 ;;; cmu17 note: since std-instance-p is weakened, that branch may run
diff --git a/pcl/dlisp2.lisp b/pcl/dlisp2.lisp
index d2cf9e8faa8b18e77d68a6c2e7735383fcc59dfd..eb2e019077089da3c3063fc6d63468cac4fae37b 100644
--- a/pcl/dlisp2.lisp
+++ b/pcl/dlisp2.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp2.lisp,v 1.7 1999/05/30 23:13:58 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp2.lisp,v 1.8 2002/08/26 02:23:13 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -93,46 +93,46 @@
     (cached-emf-p return-value-p metatypes applyp)
   (declare (ignore applyp))
   (if cached-emf-p
-      #'(lambda (cache miss-fn)
-	  (declare (type function miss-fn))
-	  #'(kernel:instance-lambda (&rest args)
-	      (declare #.*optimize-speed*)
-	      #+copy-&rest-arg (setq args (copy-list args))
-	      (with-dfun-wrappers (args metatypes)
-		(dfun-wrappers invalid-wrapper-p)
-		(apply miss-fn args)
-		(if invalid-wrapper-p
-		    (apply miss-fn args)
-		    (let ((emf (probe-cache cache dfun-wrappers not-in-cache)))
-		      (if (eq emf not-in-cache)
-			  (apply miss-fn args)
-			  (if return-value-p
-			      emf
-			      (invoke-emf emf args))))))))
-      #'(lambda (cache emf miss-fn)
-	  (declare (type function miss-fn))
-	  #'(kernel:instance-lambda (&rest args)
-	      (declare #.*optimize-speed*)
-	      #+copy-&rest-arg (setq args (copy-list args))
-	      (with-dfun-wrappers (args metatypes)
-		(dfun-wrappers invalid-wrapper-p)
-		(apply miss-fn args)
-		(if invalid-wrapper-p
-		    (apply miss-fn args)
-		    (let ((found-p (not (eq not-in-cache
-					    (probe-cache cache dfun-wrappers
-							 not-in-cache)))))
-		      (if found-p
-			  (invoke-emf emf args)
-			  (if return-value-p
-			      t
-			      (apply miss-fn args))))))))))
+      (lambda (cache miss-fn)
+	(declare (type function miss-fn))
+	#'(kernel:instance-lambda (&rest args)
+            (declare #.*optimize-speed*)
+	    #+copy-&rest-arg (setq args (copy-list args))
+	    (with-dfun-wrappers (args metatypes)
+	      (dfun-wrappers invalid-wrapper-p)
+	      (apply miss-fn args)
+	      (if invalid-wrapper-p
+		  (apply miss-fn args)
+		  (let ((emf (probe-cache cache dfun-wrappers not-in-cache)))
+		    (if (eq emf not-in-cache)
+			(apply miss-fn args)
+			(if return-value-p
+			    emf
+			    (invoke-emf emf args))))))))
+      (lambda (cache emf miss-fn)
+	(declare (type function miss-fn))
+	#'(kernel:instance-lambda (&rest args)
+	    (declare #.*optimize-speed*)
+	    #+copy-&rest-arg (setq args (copy-list args))
+	    (with-dfun-wrappers (args metatypes)
+	      (dfun-wrappers invalid-wrapper-p)
+	      (apply miss-fn args)
+	      (if invalid-wrapper-p
+		  (apply miss-fn args)
+		  (let ((found-p (not (eq not-in-cache
+					  (probe-cache cache dfun-wrappers
+						       not-in-cache)))))
+		    (if found-p
+			(invoke-emf emf args)
+			(if return-value-p
+			    t
+			    (apply miss-fn args))))))))))
 
 
 (defun emit-default-only-function (metatypes applyp)
   (declare (ignore metatypes applyp))
-  (values #'(lambda (emf)
-	      #'(lambda (&rest args)
-		  #+copy-&rest-arg (setq args (copy-list args))
-		  (invoke-emf emf args)))
+  (values (lambda (emf)
+	    (lambda (&rest args)
+	      #+copy-&rest-arg (setq args (copy-list args))
+	      (invoke-emf emf args)))
 	  t))
diff --git a/pcl/env.lisp b/pcl/env.lisp
index c1f325d9de9035c1321eb1fd308c7495942b49ae..3face3a5775abc0f0c2629f96d74ce3cd2fda1d0 100644
--- a/pcl/env.lisp
+++ b/pcl/env.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/env.lisp,v 1.14 2002/06/05 23:00:11 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/env.lisp,v 1.15 2002/08/26 02:23:13 pmai Exp $")
 ;;;
 ;;; Basic environmental stuff.
 ;;;
@@ -334,10 +334,10 @@
 
 (macrolet ((frob (&rest names)
 	     `(progn
-		,@(mapcar #'(lambda (name)
-			      `(defmethod ,name ((class lisp:class))
-				 (funcall #',name
-					  (coerce-to-pcl-class class))))
+		,@(mapcar (lambda (name)
+			    `(defmethod ,name ((class lisp:class))
+			      (funcall #',name
+			       (coerce-to-pcl-class class))))
 			  names))))
   (frob
     class-direct-slots
diff --git a/pcl/extensions.lisp b/pcl/extensions.lisp
index 524470cf5bc2230991fa4a31a0b8d98c8e21f2cc..463bf74bc9a91c5fc07e84a13abff8e22dfa1b37 100644
--- a/pcl/extensions.lisp
+++ b/pcl/extensions.lisp
@@ -18,7 +18,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/extensions.lisp,v 1.4 2002/08/24 13:46:52 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/extensions.lisp,v 1.5 2002/08/26 02:23:13 pmai Exp $")
 ;;;
 
 (in-package 'pcl)
@@ -67,12 +67,12 @@
     updater))
 
 
-(defun finalize-all-classes (&optional (root-name 't))
+(defun finalize-all-classes (&optional (root-name t))
   "Makes sure that all classes are finalized.  If Root-Name is supplied,
    then finalizes Root-Name and all of its subclasses and their subclasses."
-  (map-all-classes #'(lambda (class)
-                       (unless (class-finalized-p class)
-                         (finalize-inheritance class)))
+  (map-all-classes (lambda (class)
+		     (unless (class-finalized-p class)
+		       (finalize-inheritance class)))
                    root-name))
 
 
@@ -111,7 +111,7 @@
   (cond
    ((consp wrapper)
     `(let ((wrapper ,wrapper))
-       (unless (eq (wrapper-state wrapper) 't)
+       (unless (eq (wrapper-state wrapper) t)
          (setf wrapper (wrapper-state-trap wrapper ,instance)))
        (with-slots-slot-value-from-index
          ,instance wrapper ,slot-name ,slots ,index ,variable-instance)))
@@ -127,7 +127,7 @@
   (cond
    ((consp wrapper)
     `(let ((wrapper ,wrapper))
-       (unless (eq (wrapper-state wrapper) 't)
+       (unless (eq (wrapper-state wrapper) t)
          (setf wrapper (wrapper-state-trap wrapper ,instance)))
        (set-with-slots-slot-value-from-index
          ,instance wrapper ,slot-name ,slots ,index ,variable-instance
@@ -153,7 +153,7 @@
    ((consp wrapper)
     `(if *safe-to-use-slot-value-wrapper-optimizations-p*
          (let ((wrapper ,wrapper))
-           (unless (eq (wrapper-state wrapper) 't)
+           (unless (eq (wrapper-state wrapper) t)
              (setf wrapper (wrapper-state-trap wrapper ,instance)))
            (slot-value-from-wrapper-and-slots ,instance ,slot-name
              wrapper ,slots-layout ,slots NIL))
@@ -174,7 +174,7 @@
    ((consp wrapper)
     `(if *safe-to-use-set-slot-value-wrapper-optimizations-p*
          (let ((wrapper ,wrapper))
-           (unless (eq (wrapper-state wrapper) 't)
+           (unless (eq (wrapper-state wrapper) t)
              (setf wrapper (wrapper-state-trap wrapper ,instance)))
            (setf (slot-value-from-wrapper-and-slots ,instance ,slot-name
                     wrapper ,slots-layout ,slots NIL)
@@ -299,16 +299,16 @@
          #+pcl-user-instances
          (type-var-user 3)
          (slot-index-vars
-           (mapcar #'(lambda (slot-entry)
-                         (list (car slot-entry)
-                               (cdr slot-entry)
-                               (gensym (concatenate
-                                         'simple-string
-                                         (if (string= instance-string "")
-                                             "INSTANCE-FORM-"
-                                           instance-string)
-                                         (symbol-name (cdr slot-entry))
-                                         "-INDEX"))))
+           (mapcar (lambda (slot-entry)
+		     (list (car slot-entry)
+			   (cdr slot-entry)
+			   (gensym (concatenate
+				    'simple-string
+				    (if (string= instance-string "")
+					"INSTANCE-FORM-"
+					instance-string)
+				    (symbol-name (cdr slot-entry))
+				    "-INDEX"))))
                    (remove-duplicates hard-accessors :key #'cdr)))
          (slots-layout-var
            (gensym (concatenate 'simple-string "SLOTS-LAYOUT-" instance-string)))
@@ -394,33 +394,33 @@
                        prototype-form slot-index-vars)))))
        (symbol-macrolet
          (,@(mapcar
-              #'(lambda (slot-cons)
-                  `(,(car slot-cons)
-                     (with-slots-slot-value-from-index
-                        ,instance-form-var
-                        ,runtime-wrapper-form
-                        ',(cdr slot-cons)
-                        ,runtime-slots-form
-                        ,(third (assoc (car slot-cons) slot-index-vars
-                                       :test #'eq))
-                        ,(when (and variable-instance
-                                    (not (eq variable-instance
-                                             instance-form-var)))
+              (lambda (slot-cons)
+		`(,(car slot-cons)
+		  (with-slots-slot-value-from-index
+		      ,instance-form-var
+		    ,runtime-wrapper-form
+		    ',(cdr slot-cons)
+		    ,runtime-slots-form
+		    ,(third (assoc (car slot-cons) slot-index-vars
+				   :test #'eq))
+		    ,(when (and variable-instance
+				(not (eq variable-instance
+					 instance-form-var)))
                            variable-instance))))
               hard-accessors)
           ,@(mapcar
-              #'(lambda (variable-cons)
-                  `(,(car variable-cons)
-                    (with-slots-slot-value-from-wrapper-and-slots
+              (lambda (variable-cons)
+		`(,(car variable-cons)
+		  (with-slots-slot-value-from-wrapper-and-slots
                       ,instance-form-var
-                      ,(second variable-cons)
-                      ,runtime-wrapper-form
-                      ,slots-layout-var
-                      ,runtime-slots-form
-                      ,(when (and variable-instance
-                                  (not (eq variable-instance
-                                           instance-form-var)))
-                         variable-instance))))
+		    ,(second variable-cons)
+		    ,runtime-wrapper-form
+		    ,slots-layout-var
+		    ,runtime-slots-form
+		    ,(when (and variable-instance
+				(not (eq variable-instance
+					 instance-form-var)))
+			   variable-instance))))
               variable-accessors))
          ,@body))))
 
@@ -428,16 +428,16 @@
                                       prototype-form
                                       slot-index-vars)
   (declare (type list slot-index-vars))
-  `((unless (eq (wrapper-state ,wrapper-var) 't)
+  `((unless (eq (wrapper-state ,wrapper-var) t)
       (setf ,wrapper-var
             (wrapper-state-trap ,wrapper-var ,prototype-form)))
     (setf ,slots-layout-var (wrapper-instance-slots-layout ,wrapper-var))
     ,@(if (<= (length slot-index-vars) 2)
           (mapcar
-            #'(lambda (slot-cons)
-                `(setf ,(third slot-cons)
-                       (instance-slot-index-from-slots-layout
-                         ,slots-layout-var ',(second slot-cons))))
+            (lambda (slot-cons)
+	      `(setf ,(third slot-cons)
+		(instance-slot-index-from-slots-layout
+		 ,slots-layout-var ',(second slot-cons))))
             slot-index-vars)
           ;; More than two slots, so more efficient to search slots-layout-var
           ;; only once, rather than once for each with instance-slot-index.
@@ -478,16 +478,16 @@
             `((,instance-form-var ,instance-form))))
      (symbol-macrolet
        (,@(mapcar
-            #'(lambda (slot-cons)
-                `(,(car slot-cons)
-                  (accessor-slot-value ,instance-form-var
-                                       ',(cdr slot-cons))))
+            (lambda (slot-cons)
+	      `(,(car slot-cons)
+		(accessor-slot-value ,instance-form-var
+		 ',(cdr slot-cons))))
             hard-accessors)
         ,@(mapcar
-            #'(lambda (variable-cons)
-                `(,(car variable-cons)
-                  (accessor-slot-value ,instance-form-var
-                                       ,(second variable-cons))))
+            (lambda (variable-cons)
+	      `(,(car variable-cons)
+		(accessor-slot-value ,instance-form-var
+		 ,(second variable-cons))))
             variable-accessors))
        ,@body))))
 
diff --git a/pcl/fast-init.lisp b/pcl/fast-init.lisp
index 2d091742fa12e09d1e8577f53ba9a3e03c6d65b9..931722f5bb09b92d0fc540619f51cc1f143e0a8f 100644
--- a/pcl/fast-init.lisp
+++ b/pcl/fast-init.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/fast-init.lisp,v 1.7 2002/04/13 22:40:07 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/fast-init.lisp,v 1.8 2002/08/26 02:23:13 pmai Exp $")
 ;;;
 ;;; This file defines the optimized make-instance functions.
 ;;; 
@@ -59,7 +59,7 @@
 			 (return nil))		       
 		       (setq key (eval (pop initargs-tail)))
 		       (setq value (pop initargs-tail))
-		       (when (eq ':allow-other-keys key)
+		       (when (eq :allow-other-keys key)
 			 (setq allow-other-keys-p value))
 		       (push key keys))))
       (let* ((class (eval class))
@@ -88,15 +88,15 @@
 	  
 (defmacro expanding-make-instance (&rest forms &environment env)
   `(progn
-     ,@(mapcar #'(lambda (form)
-		   (walk-form form env 
-			      #'(lambda (subform context env)
-				  (declare (ignore env))
-				  (or (and (eq context ':eval)
-					   (consp subform)
-					   (eq (car subform) 'make-instance)
-					   (expand-make-instance-form subform))
-				      subform))))
+     ,@(mapcar (lambda (form)
+		 (walk-form form env 
+			    (lambda (subform context env)
+			      (declare (ignore env))
+			      (or (and (eq context :eval)
+				       (consp subform)
+				       (eq (car subform) 'make-instance)
+				       (expand-make-instance-form subform))
+				  subform))))
 	       forms)))
 
 (defmacro defconstructor
@@ -146,7 +146,7 @@
 	(cached-name (intern (format nil "~A-CACHED-~A" type name))))
     `(defmacro ,reader-name (info)
        `(let ((value (,',cached-name ,info)))
-	  (if (eq value ':unknown)
+	  (if (eq value :unknown)
 	      (progn
 		(,',trap ,info ',',name)
 		(,',cached-name ,info))
@@ -168,35 +168,35 @@
 
 (defmacro define-initialize-info ()
   (let ((cached-slot-names 
-	 (mapcar #'(lambda (name)
-		     (intern (format nil "CACHED-~A" name)))
+	 (mapcar (lambda (name)
+		   (intern (format nil "CACHED-~A" name)))
 		 initialize-info-cached-slots))
 	(cached-names
-	 (mapcar #'(lambda (name)
-		     (intern (format nil "~A-CACHED-~A" 
-				     'initialize-info name)))
+	 (mapcar (lambda (name)
+		   (intern (format nil "~A-CACHED-~A" 
+				   'initialize-info name)))
 		 initialize-info-cached-slots)))
     `(progn
        (defstruct initialize-info 
 	 key wrapper 
-	 ,@(mapcar #'(lambda (name)
-		       `(,name :unknown))
+	 ,@(mapcar (lambda (name)
+		     `(,name :unknown))
 		   cached-slot-names))
        (defmacro reset-initialize-info-internal (info)
 	 `(progn 
-	    ,@(mapcar #'(lambda (cname)
-			  `(setf (,cname ,info) ':unknown))
+	    ,@(mapcar (lambda (cname)
+			`(setf (,cname ,info) :unknown))
 		      ',cached-names)))
        (defun initialize-info-bound-slots (info)
 	 (let ((slots nil))
-	   ,@(mapcar #'(lambda (name cached-name)
-			 `(unless (eq ':unknown (,cached-name info))
-			    (push ',name slots)))
+	   ,@(mapcar (lambda (name cached-name)
+		       `(unless (eq :unknown (,cached-name info))
+			  (push ',name slots)))
 		     initialize-info-cached-slots cached-names)
 	   slots))
-      ,@(mapcar #'(lambda (name)
-		    `(define-cached-reader initialize-info ,name 
-		      update-initialize-info-internal))
+      ,@(mapcar (lambda (name)
+		  `(define-cached-reader initialize-info ,name 
+		     update-initialize-info-internal))
 	        initialize-info-cached-slots))))
 
 (define-initialize-info)
@@ -356,7 +356,7 @@
       (setq class (find-class class)))
     (when (classp class)
       (unless (class-finalized-p class) (finalize-inheritance class)))
-    (let* ((initargs (mapcan #'(lambda (key) (list key nil)) keys))
+    (let* ((initargs (mapcan (lambda (key) (list key nil)) keys))
 	   (class-and-initargs (list* class initargs))
 	   (make-instance (gdefinition 'make-instance))
 	   (make-instance-methods
@@ -377,8 +377,8 @@
 					  (list* proto t initargs)))))
       (when (null make-instance-methods)
 	(return-from get-make-instance-function
-	  #'(lambda (class initargs)
-	      (apply #'no-applicable-method make-instance class initargs))))
+	  (lambda (class initargs)
+	    (apply #'no-applicable-method make-instance class initargs))))
       (unless (and (null (cdr make-instance-methods))
 		   (eq (car make-instance-methods) std-mi-meth)
 		   (null (cdr default-initargs-methods))
@@ -390,8 +390,8 @@
 				  (eq (car (method-specializers meth))
 				      *the-class-slot-object*)
 				  (and (null (cdr quals))
-				       (or (eq (car quals) ':before)
-					   (eq (car quals) ':after)))))))
+				       (or (eq (car quals) :before)
+					   (eq (car quals) :after)))))))
 		     (and (every #'check-meth initialize-instance-methods)
 			  (every #'check-meth shared-initialize-methods))))
 	(return-from get-make-instance-function nil))
@@ -430,7 +430,7 @@
 (defun complicated-instance-creation-method (m)
   (let ((qual (method-qualifiers m)))
     (if qual 
-	(not (and (null (cdr qual)) (eq (car qual) ':after)))
+	(not (and (null (cdr qual)) (eq (car qual) :after)))
 	(let ((specl (car (method-specializers m))))
 	  (or (not (classp specl))
 	      (not (eq 'slot-object (class-name specl))))))))
@@ -472,36 +472,36 @@
 	   (std-si-meth (find-standard-ii-method shared-initialize-methods
 						 'slot-object))
 	   (shared-initfns
-	    (nreverse (mapcar #'(lambda (method)
-				  (make-effective-method-function
-				   #'shared-initialize
-				   `(call-method ,method nil)
-				   nil lwrapper))
+	    (nreverse (mapcar (lambda (method)
+				(make-effective-method-function
+				 #'shared-initialize
+				 `(call-method ,method nil)
+				 nil lwrapper))
 			      (remove std-si-meth shared-initialize-methods))))
 	   (std-ii-meth (find-standard-ii-method initialize-instance-methods
 						 'slot-object))
 	   (initialize-initfns 
-	    (nreverse (mapcar #'(lambda (method)
-				  (make-effective-method-function
-				   #'initialize-instance
-				   `(call-method ,method nil)
-				   nil lwrapper))
+	    (nreverse (mapcar (lambda (method)
+				(make-effective-method-function
+				 #'initialize-instance
+				 `(call-method ,method nil)
+				 nil lwrapper))
 			      (remove std-ii-meth
 				      initialize-instance-methods)))))
-      #'(lambda (class1 initargs)
-	  (if (not (eq wrapper (class-wrapper class)))
-	      (let* ((info (initialize-info (coerce-to-class class1) initargs))
-		     (fn (initialize-info-make-instance-function info)))
-		(declare (type function fn))
-		(funcall fn class1 initargs))
-	      (let* ((instance (funcall allocate-function wrapper constants))
-		     (initargs (call-initialize-function initialize-function
-							 instance initargs)))
-		(dolist (fn shared-initfns)
-		  (invoke-effective-method-function fn t instance t initargs))
-		(dolist (fn initialize-initfns)
-		  (invoke-effective-method-function fn t instance initargs))
-		instance))))))
+      (lambda (class1 initargs)
+	(if (not (eq wrapper (class-wrapper class)))
+	    (let* ((info (initialize-info (coerce-to-class class1) initargs))
+		   (fn (initialize-info-make-instance-function info)))
+	      (declare (type function fn))
+	      (funcall fn class1 initargs))
+	    (let* ((instance (funcall allocate-function wrapper constants))
+		   (initargs (call-initialize-function initialize-function
+						       instance initargs)))
+	      (dolist (fn shared-initfns)
+		(invoke-effective-method-function fn t instance t initargs))
+	      (dolist (fn initialize-initfns)
+		(invoke-effective-method-function fn t instance initargs))
+	      instance))))))
 
 (defun make-instance-function-complex (key class keys
 					   initialize-instance-methods
@@ -514,35 +514,35 @@
 	     #'shared-initialize shared-initialize-methods
 	     `((class-eq ,class) t t)
 	     `((,(find-standard-ii-method shared-initialize-methods 'slot-object)
-		,#'(lambda (instance init-type &rest initargs)
-		     (declare (ignore init-type))
-		     #+copy-&rest-arg (setq initargs (copy-list initargs))
-		     (call-initialize-function initialize-function 
-					       instance initargs)
-		     instance)))
+		,(lambda (instance init-type &rest initargs)
+		    (declare (ignore init-type))
+		    #+copy-&rest-arg (setq initargs (copy-list initargs))
+		    (call-initialize-function initialize-function 
+					      instance initargs)
+		    instance)))
 	     (list wrapper *the-wrapper-of-t* *the-wrapper-of-t*)))
 	   (initialize-instance
 	    (get-secondary-dispatch-function
 	     #'initialize-instance initialize-instance-methods
 	     `((class-eq ,class) t)
 	     `((,(find-standard-ii-method initialize-instance-methods 'slot-object)
-		,#'(lambda (instance &rest initargs)
-		     #+copy-&rest-arg (setq initargs (copy-list initargs))
-		     (invoke-effective-method-function
-		      shared-initialize t instance t initargs))))
+		,(lambda (instance &rest initargs)
+		   #+copy-&rest-arg (setq initargs (copy-list initargs))
+		   (invoke-effective-method-function
+		    shared-initialize t instance t initargs))))
 	     (list wrapper *the-wrapper-of-t*))))
-      #'(lambda (class1 initargs)
-	  (if (not (eq wrapper (class-wrapper class)))
-	      (let* ((info (initialize-info (coerce-to-class class1) initargs))
-		     (fn (initialize-info-make-instance-function info)))
-		(declare (type function fn))
-		(funcall fn class1 initargs))
-	      (let* ((initargs (call-initialize-function initargs-function 
-							 nil initargs))
-		     (instance (apply #'allocate-instance class initargs)))
-		(invoke-effective-method-function
-		 initialize-instance t instance initargs)
-		instance))))))
+      (lambda (class1 initargs)
+	(if (not (eq wrapper (class-wrapper class)))
+	    (let* ((info (initialize-info (coerce-to-class class1) initargs))
+		   (fn (initialize-info-make-instance-function info)))
+	      (declare (type function fn))
+	      (funcall fn class1 initargs))
+	    (let* ((initargs (call-initialize-function initargs-function 
+						       nil initargs))
+		   (instance (apply #'allocate-instance class initargs)))
+	      (invoke-effective-method-function
+	       initialize-instance t instance initargs)
+	      instance))))))
 
 (defun get-simple-initialization-function (class keys &optional allow-other-keys-arg)
   (let ((info (initialize-info class keys nil allow-other-keys-arg)))
@@ -575,10 +575,10 @@
 	(default-initargs (class-default-initargs class))
 	(nkeys keys)
 	(slots-alist
-	 (mapcan #'(lambda (slot)
-		     (mapcar #'(lambda (arg)
-				 (cons arg slot))
-			     (slot-definition-initargs slot)))
+	 (mapcan (lambda (slot)
+		   (mapcar (lambda (arg)
+			     (cons arg slot))
+			   (slot-definition-initargs slot)))
 		 (class-slots class)))
 	(nslots nil))
     (dolist (key nkeys)
@@ -612,15 +612,15 @@
 	 (wrapper (class-wrapper class))
 	 (constants (when simple-p
 		      (make-list (wrapper-no-of-instance-slots wrapper)
-				 ':initial-element *slot-unbound*)))
+				 :initial-element *slot-unbound*)))
 	 (slots (class-slots class))
 	 (slot-names (mapcar #'slot-definition-name slots))
-	 (slots-key (mapcar #'(lambda (slot)
-				(let ((index most-positive-fixnum))
-				  (dolist (key (slot-definition-initargs slot))
-				    (let ((pos (position key keys)))
-				      (when pos (setq index (min index pos)))))
-				  (cons slot index)))
+	 (slots-key (mapcar (lambda (slot)
+			      (let ((index most-positive-fixnum))
+				(dolist (key (slot-definition-initargs slot))
+				  (let ((pos (position key keys)))
+				    (when pos (setq index (min index pos)))))
+				(cons slot index)))
 			    slots))
 	 (slots (stable-sort slots-key #'< :key #'cdr)))
     (let ((n-popped 0))
@@ -639,7 +639,7 @@
       (let* ((slot (car slot+index))
 	     (name (slot-definition-name slot)))
 	(when (and (eql (cdr slot+index) most-positive-fixnum)
-		   (or (eq si-slot-names 't)
+		   (or (eq si-slot-names t)
 		       (member name si-slot-names)))
 	  (let* ((initform (slot-definition-initform slot))
 		 (initfunction (slot-definition-initfunction slot))
@@ -710,7 +710,7 @@
 		(apply (the function (cadr entry)) args)
 		`(call-initialize-instance-simple ,pv-cell ,form-list))))
 	#||
-	#'(lambda (instance initargs)
+	(lambda (instance initargs)
 	    (initialize-instance-simple pv-cell form-list instance initargs))
 	||#
 	`(call-initialize-instance-simple ,pv-cell ,form-list))))
@@ -733,12 +733,14 @@
 (defmacro precompile-iis-functions (&optional system)
   (let ((index -1))
     `(progn
-      ,@(gathering1 (collecting)
-	 (dolist (iis-entry *initialize-instance-simple-alist*)
+      ,@(let ((collected ()))
+	 (dolist (iis-entry *initialize-instance-simple-alist*
+		  (nreverse collected))
 	   (when (or (null (caddr iis-entry))
 		     (eq (caddr iis-entry) system))
-	     (when system (setf (caddr iis-entry) system))
-	     (gather1
+	     (when system
+	       (setf (caddr iis-entry) system))
+	     (push
 	      (make-top-level-form
 	       `(precompile-initialize-instance-simple ,system ,(incf index))
 	       '(load)
@@ -746,7 +748,8 @@
 		 ',(car iis-entry)
 		 #',(car iis-entry)
 		 ',system
-		 ',(cdddr iis-entry))))))))))
+		 ',(cdddr iis-entry)))
+	      collected)))))))
 
 (defun compile-iis-functions (after-p)
   (let ((*compile-make-instance-functions-p* t)
@@ -849,9 +852,9 @@
 	       `((instance-write-internal pv slots ,(const pv-offset) value
 		  ,default
 		  ,(typecase location
-		     (fixnum ':instance)
-		     (cons ':class)
-		     (t ':default)))))))
+		     (fixnum :instance)
+		     (cons :class)
+		     (t :default)))))))
 	(skip-when-instance-boundp
 	 (let* ((pv-offset (cadr form))
 		(location (pvref pv pv-offset))
@@ -866,9 +869,9 @@
 			  `(instance-boundp-internal pv slots ,(const pv-offset)
 			    ,default
 			    ,(typecase (pvref pv pv-offset)
-			       (fixnum ':instance)
-			       (cons ':class)
-			       (t ':default))))
+			       (fixnum :instance)
+			       (cons :class)
+			       (t :default))))
 	       ,@(let ((sforms (cons nil nil)))
 		   (dotimes (i (cadddr form) (car sforms))
 		     (add-forms (first-form-to-lisp forms cvector pv) sforms)))))))
@@ -903,10 +906,10 @@
     (values
      `(lambda (pv-cell cvector)
         (declare (type ,cvector-type cvector))
-        #'(lambda (instance initargs)
-	    (declare #.*optimize-speed*)
-	    (iis-body ,@body)
-	    initargs))
+        (lambda (instance initargs)
+	  (declare #.*optimize-speed*)
+	  (iis-body ,@body)
+	  initargs))
      (list pv-cell (coerce cvector cvector-type)))))
 
 
diff --git a/pcl/fngen.lisp b/pcl/fngen.lisp
index 4e2357902cf9e2c1fcdc4fab8a13559e20d63041..34c34a27c219c2a5e5dd1d64755ad40798003a6f 100644
--- a/pcl/fngen.lisp
+++ b/pcl/fngen.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fngen.lisp,v 1.8 1999/05/30 23:14:00 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fngen.lisp,v 1.9 2002/08/26 02:23:14 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -151,45 +151,44 @@
   (let ((walk-form-expand-macros-p t))
     (walk-form lambda
 	       nil
-	       #'(lambda (f c e)
-		   (declare (ignore e))
-		   (if (neq c :eval)
-		       f
-		       (let ((converted (funcall test-converter f)))
-			 (values converted (neq converted f))))))))
+	       (lambda (f c e)
+		 (declare (ignore e))
+		 (if (neq c :eval)
+		     f
+		     (let ((converted (funcall test-converter f)))
+		       (values converted (neq converted f))))))))
 
 (defun compute-code (lambda code-converter)
   (let ((walk-form-expand-macros-p t)
 	(gensyms ()))
     (values (walk-form lambda
 		       nil
-		       #'(lambda (f c e)
-			   (declare (ignore e))
-			   (if (neq c :eval)
-			       f
-			       (multiple-value-bind (converted gens)
-				   (funcall code-converter f)
-				 (when gens (setq gensyms (append gensyms gens)))
-				 (values converted (neq converted f))))))
+		       (lambda (f c e)
+			 (declare (ignore e))
+			 (if (neq c :eval)
+			     f
+			     (multiple-value-bind (converted gens)
+				 (funcall code-converter f)
+			       (when gens (setq gensyms (append gensyms gens)))
+			       (values converted (neq converted f))))))
 	      gensyms)))
 
 (defun compute-constants (lambda constant-converter)
-  (let ((walk-form-expand-macros-p t)) ; doesn't matter here.
-    (macrolet ((appending ()
-		 `(let ((result ()))
-		   (values #'(lambda (value) (setq result (append result value)))
-		    #'(lambda ()result)))))
-      (gathering1 (appending)
-		  (walk-form lambda
-			     nil
-			     #'(lambda (f c e)
-				 (declare (ignore e))
-				 (if (neq c :eval)
-				     f
-				     (let ((consts (funcall constant-converter f)))
-				       (if consts
-					   (progn (gather1 consts) (values f t))
-					   f)))))))))
+  (let ((walk-form-expand-macros-p t) ; doesn't matter here.
+	(collected ()))
+    (walk-form lambda
+	       nil
+	       (lambda (f c e)
+		 (declare (ignore e))
+		 (if (eq c :eval)
+		     (let ((consts (funcall constant-converter f)))
+		       (if consts
+			   (progn
+			     (setq collected (append collected consts))
+			     (values f t))
+			   f))
+		     f)))
+    collected))
 
 
 ;;;
@@ -197,12 +196,13 @@
 ;;;
 (defmacro precompile-function-generators (&optional system)
   (let ((index -1))
-    `(progn ,@(gathering1 (collecting)
-		(dolist (fgen *fgens*)
+    `(progn ,@(let ((collected ()))
+		(dolist (fgen *fgens* (nreverse collected))
 		  (when (or (null (fgen-system fgen))
 			    (eq (fgen-system fgen) system))
-		    (when system (setf (svref fgen 4) system))
-		    (gather1
+		    (when system
+		      (setf (svref fgen 4) system))
+		    (push
 		     (make-top-level-form
 		      `(precompile-function-generators ,system ,(incf index))
 		      '(load)
@@ -211,7 +211,8 @@
 			',(fgen-gensyms fgen)
 			(function ,(fgen-generator-lambda fgen))
 			',(fgen-generator-lambda fgen)
-			',system)))))))))
+			',system))
+		     collected)))))))
 
 (defun load-function-generator (test gensyms generator generator-lambda system)
   (store-fgen (make-fgen test gensyms generator generator-lambda system)))
diff --git a/pcl/init.lisp b/pcl/init.lisp
index f51f811f68c038d3b0b74d9a4247da427ccf6ade..a5f09304c96560efe11a5e469d42833b9d526f0f 100644
--- a/pcl/init.lisp
+++ b/pcl/init.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.12 2002/08/23 18:31:06 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.13 2002/08/26 02:23:14 pmai Exp $")
 ;;;
 ;;; This file defines the initialization and related protocols.
 ;;; 
@@ -115,7 +115,7 @@
 				     (class-slots (class-of previous)))))
     (dolist (slotd current-slotds)
       (if (and (not (memq (slot-definition-name slotd) previous-slot-names))
-	       (eq (slot-definition-allocation slotd) ':instance))
+	       (eq (slot-definition-allocation slotd) :instance))
 	  (push (slot-definition-name slotd) added-slots)))
     (check-initargs-1
      (class-of current) initargs
@@ -137,7 +137,7 @@
 
 (defmethod shared-initialize
     ((instance slot-object) slot-names &rest initargs)
-  (when (eq slot-names 't)
+  (when (eq slot-names t)
     (return-from shared-initialize
       (call-initialize-function
        (initialize-info-shared-initialize-t-function
@@ -182,12 +182,12 @@
 			   (when (memq initarg slot-initargs)
 			     (setf (slot-value-using-class class instance slotd)
 				   val)
-			     (return 't))))
+			     (return t))))
 	  ;; Try to initialize the slot from its initform.
 	  (if (and slot-names
-		   (or (eq slot-names 't)
+		   (or (eq slot-names t)
 		       (memq slot-name slot-names))
-		   (or (and (not std-p) (eq slot-names 't))
+		   (or (and (not std-p) (eq slot-names t))
 		       (not (slot-boundp-using-class class instance slotd))))
 	      (let ((initfunction (slot-definition-initfunction slotd)))
 		(when initfunction
@@ -208,12 +208,12 @@
 	  (check-initargs-2-list initargs class legal error-p)))))
 
 (defun check-initargs-values (class call-list)
-  (let ((methods (mapcan #'(lambda (call)
-			     (if (consp call)
-				 (copy-list (compute-applicable-methods
-					     (gdefinition (car call))
-					     (cdr call)))
-				 (list call)))
+  (let ((methods (mapcan (lambda (call)
+			   (if (consp call)
+			       (copy-list (compute-applicable-methods
+					   (gdefinition (car call))
+					   (cdr call)))
+			       (list call)))
 			 call-list))
 	(legal (apply #'append (mapcar #'slot-definition-initargs
 				       (class-slots class)))))
diff --git a/pcl/iterate.lisp b/pcl/iterate.lisp
deleted file mode 100644
index 0f736bb2ed1dd7a2167fa2e46751028cdc05c98c..0000000000000000000000000000000000000000
--- a/pcl/iterate.lisp
+++ /dev/null
@@ -1,1264 +0,0 @@
-;;;-*- Package: ITERATE; Syntax: Common-Lisp; Base: 10 -*-
-;;;
-;;; *************************************************************************
-;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
-;;; All rights reserved.
-;;;
-;;; Use and copying of this software and preparation of derivative works
-;;; based upon this software are permitted.  Any distribution of this
-;;; software or derivative works must comply with all applicable United
-;;; States export control laws.
-;;; 
-;;; This software is made available AS IS, and Xerox Corporation makes no
-;;; warranty about the software, its performance or its conformity to any
-;;; specification.
-;;; 
-;;; Any person obtaining a copy of this software is requested to send their
-;;; name and post office or electronic mail address to:
-;;;   CommonLoops Coordinator
-;;;   Xerox PARC
-;;;   3333 Coyote Hill Rd.
-;;;   Palo Alto, CA 94304
-;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
-;;;
-;;; Suggestions, comments and requests for improvements are also welcome.
-;;; *************************************************************************
-;;;
-
-(ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/iterate.lisp,v 1.7 1999/05/30 23:14:01 pw Exp $")
-;;; 
-;;; Original source {pooh/n}<pooh>vanmelle>lisp>iterate;4 created 27-Sep-88 12:35:33
-
-(defpackage "ITERATE" (:use :common-lisp :walker)
-  (:export "ITERATE" "ITERATE*" "GATHERING" "GATHER" "WITH-GATHERING"
-	   "INTERVAL" "ELEMENTS" "LIST-ELEMENTS" "LIST-TAILS"
-	   "PLIST-ELEMENTS" "EACHTIME" "WHILE" "UNTIL"
-	   "COLLECTING" "JOINING" "MAXIMIZING" "MINIMIZING" "SUMMING"
-	   "*ITERATE-WARNINGS*"))
-
-(in-package "ITERATE")
-
-(defvar *iterate-warnings* :any "Controls whether warnings are issued for iterate/gather forms that aren't optimized.
-NIL => never; :USER => those resulting from user code; T => always, even if it's the iteration macro that's suboptimal."
-       )
-
-;;; ITERATE macro
-
-
-(defmacro iterate (clauses &body body &environment env)
-       (optimize-iterate-form clauses body env))
-
-(defun
- simple-expand-iterate-form
- (clauses body)
- 
- ;; Expand ITERATE.  This is the "formal semantics" expansion, which we never
- ;; use.
- (let*
-  ((block-name (gensym))
-   (bound-var-lists (mapcar #'(lambda (clause)
-                                     (let ((names (first clause)))
-                                          (if (listp names)
-                                              names
-                                              (list names))))
-                           clauses))
-   (generator-vars (mapcar #'(lambda (clause)
-                                    (declare (ignore clause))
-                                    (gensym))
-                          clauses)))
-  `(block ,block-name
-       (let*
-        ,(mapcan #'(lambda (gvar clause var-list)
-                                               ; For each clause, bind a
-                                               ; generator temp to the clause,
-                                               ; then bind the specified
-                                               ; var(s)
-                          (cons (list gvar (second clause))
-                                (copy-list var-list)))
-                generator-vars clauses bound-var-lists)
-        
-        ;; Note bug in formal semantics: there can be declarations in the head
-        ;; of BODY; they go here, rather than inside loop
-        (loop
-         ,@(mapcar
-            #'(lambda (var-list gen-var)
-                                               ; Set each bound variable (or
-                                               ; set of vars) to the result of
-                                               ; calling the corresponding
-                                               ; generator
-                     `(multiple-value-setq
-                       ,var-list
-                       (funcall ,gen-var #'(lambda nil (return-from
-                                                        ,block-name)))))
-            bound-var-lists generator-vars)
-         ,@body)))))
-
-(defparameter *iterate-temp-vars-list*
-       '(iterate-temp-1 iterate-temp-2 iterate-temp-3 iterate-temp-4 
-               iterate-temp-5 iterate-temp-6 iterate-temp-7 iterate-temp-8)
-       "Temp var names used by ITERATE expansions.")
-
-(defun
- optimize-iterate-form
- (clauses body iterate-env)
- (let*
-  ((temp-vars *iterate-temp-vars-list*)
-   (block-name (gensym))
-   (finish-form `(return-from ,block-name))
-   (bound-vars (mapcan #'(lambda (clause)
-                                (let ((names (first clause)))
-                                     (if (listp names)
-                                         (copy-list names)
-                                         (list names))))
-                      clauses))
-   iterate-decls generator-decls update-forms bindings leftover-body)
-  (do ((tail bound-vars (cdr tail)))
-      ((null tail))
-                                               ; Check for duplicates
-    (when (member (car tail)
-                 (cdr tail))
-        (warn "Variable appears more than once in ITERATE: ~S" (car tail))))
-  (flet
-   ((get-iterate-temp nil 
-
-           ;; Make temporary var.  Note that it is ok to re-use these symbols
-           ;; in each iterate, because they are not used within BODY.
-           (or (pop temp-vars)
-               (gensym))))
-   (dolist (clause clauses)
-       (cond
-        ((or (not (consp clause))
-             (not (consp (cdr clause))))
-         (warn "Bad syntax in ITERATE: clause not of form (var iterator): ~S" 
-               clause))
-        (t
-         (unless (null (cddr clause))
-                (warn 
-       "Probable parenthesis error in ITERATE clause--more than 2 elements: ~S"
-                      clause))
-         (multiple-value-bind
-          (let-body binding-type let-bindings localdecls otherdecls extra-body)
-          (expand-into-let (second clause)
-                 'iterate iterate-env)
-          
-          ;; We have expanded the generator clause and parsed it into its LET
-          ;; pieces.
-          (prog*
-           ((vars (first clause))
-            gen-args renamed-vars)
-           (setq vars (if (listp vars)
-                          (copy-list vars)
-                          (list vars)))
-                                               ; VARS is now a (fresh) list of
-                                               ; all iteration vars bound in
-                                               ; this clause
-           (cond
-            ((eq let-body :abort)
-                                               ; Already issued a warning
-                                               ; about malformedness
-             )
-            ((null (setq let-body (function-lambda-p let-body 1)))
-                                               ; Not of the expected form
-             (let ((generator (second clause)))
-                  (cond ((and (consp generator)
-                              (fboundp (car generator)))
-                                               ; It looks ok--a macro or
-                                               ; function here--so the guy who
-                                               ; wrote it just didn't do it in
-                                               ; an optimizable way
-                         (maybe-warn :definition "Could not optimize iterate clause ~S because generator not of form (LET[*] ... (FUNCTION (LAMBDA (finish) ...)))"
-                                generator))
-                        (t                     ; Perhaps it's just a
-                                               ; misspelling?  Probably user
-                                               ; error
-                           (maybe-warn :user 
-                                "Iterate operator in clause ~S is not fboundp."
-                                  generator)))
-                  (setq let-body :abort)))
-            (t
-             
-             ;; We have something of the form #'(LAMBDA (finisharg) ...),
-             ;; possibly with some LET bindings around it.  LET-BODY =
-             ;; ((finisharg) ...).
-             (setq let-body (cdr let-body))
-             (setq gen-args (pop let-body))
-             (when let-bindings
-                 
-                 ;; The first transformation we want to perform is
-                 ;; "LET-eversion": turn (let* ((generator (let (..bindings..)
-                 ;; #'(lambda ...)))) ..body..) into (let* (..bindings..
-                 ;; (generator #'(lambda ...))) ..body..).  This
-                 ;; transformation is valid if nothing in body refers to any
-                 ;; of the bindings, something we can assure by
-                 ;; alpha-converting the inner let (substituting new names for
-                 ;; each var).  Of course, none of those vars can be special,
-                 ;; but we already checked for that above.
-                 (multiple-value-setq (let-bindings renamed-vars)
-                        (rename-let-bindings let-bindings binding-type 
-                               iterate-env leftover-body #'get-iterate-temp))
-                 (setq leftover-body nil)
-                                               ; If there was any leftover
-                                               ; from previous, it is now
-                                               ; consumed
-                 )
-             
-             ;; The second transformation is substituting the body of the
-             ;; generator (LAMBDA (finish-arg) . gen-body) for its appearance
-             ;; in the update form (funcall generator #'(lambda ()
-             ;; finish-form)), then simplifying that form.  The requirement
-             ;; for this part is that the generator body not refer to any
-             ;; variables that are bound between the generator binding and the
-             ;; appearance in the loop body.  The only variables bound in that
-             ;; interval are generator temporaries, which have unique names so
-             ;; are no problem, and the iteration variables remaining for
-             ;; subsequent clauses.  We'll discover the story as we walk the
-             ;; body.
-             (multiple-value-bind
-              (finishdecl other rest)
-              (parse-declarations let-body gen-args)
-              (declare (ignore finishdecl))
-                                               ; Pull out declares, if any,
-                                               ; separating out the one(s)
-                                               ; referring to the finish arg,
-                                               ; which we will throw away
-              (when other
-                                               ; Combine remaining decls with
-                                               ; decls extracted from the LET,
-                                               ; if any
-                  (setq otherdecls (nconc otherdecls other)))
-              (setq let-body (cond
-                              (otherdecls
-                                               ; There are interesting
-                                               ; declarations, so have to keep
-                                               ; it wrapped.
-                               `(let nil (declare ,@otherdecls)
-                                     ,@rest))
-                              ((null (cdr rest))
-                                               ; Only one form left
-                               (first rest))
-                              (t `(progn ,@rest)))))
-             (unless (eq (setq let-body (iterate-transform-body let-body 
-                                               iterate-env renamed-vars
-                                               (first gen-args)
-                                               finish-form bound-vars clause))
-                         :abort)
-                 
-                 ;; Skip the rest if transformation failed.  Warning has
-                 ;; already been issued.
-                 
-                 ;; Note possible further optimization: if LET-BODY expanded
-                 ;; into (prog1 oldvalue prepare-for-next-iteration), as so
-                 ;; many do, then we could in most cases split the PROG1 into
-                 ;; two pieces: do the (setq var oldvalue) here, and do the
-                 ;; prepare-for-next-iteration at the bottom of the loop. 
-                 ;; This does a slight optimization of the PROG1 and also
-                 ;; rearranges the code in a way that a reasonably clever
-                 ;; compiler might detect how to get rid of redundant
-                 ;; variables altogether (such as happens with INTERVAL and
-                 ;; LIST-TAILS); that would make the whole thing closer to
-                 ;; what you might have coded by hand.  However, to do this
-                 ;; optimization, we need to assure that (a) the
-                 ;; prepare-for-next-iteration refers freely to no vars other
-                 ;; than the internal vars we have extracted from the LET, and
-                 ;; (b) that the code has no side effects.  These are both
-                 ;; true for all the iterators defined by this module, but how
-                 ;; shall we represent side-effect info and/or tap into the
-                 ;; compiler's knowledge of same?
-                 (when localdecls
-                                               ; There were declarations for
-                                               ; the generator locals--have to
-                                               ; keep them for later, and
-                                               ; rename the vars mentioned
-                     (setq
-                      generator-decls
-                      (nconc
-                       generator-decls
-                       (mapcar
-                        #'(lambda
-                           (decl)
-                           (let ((head (car decl)))
-                                (cons head (if (eq head 'type)
-                                               (cons (second decl)
-                                                     (sublis renamed-vars
-                                                            (cddr decl)))
-                                               (sublis renamed-vars
-                                                      (cdr decl))))))
-                        localdecls)))))))
-           
-           ;; Finished analyzing clause now.  LET-BODY is the form which, when
-           ;; evaluated, returns updated values for the iteration variable(s)
-           ;; VARS.
-           (when (eq let-body :abort)
-               
-               ;; Some punt case: go with the formal semantics: bind a var to
-               ;; the generator, then call it in the update section
-               (let
-                ((gvar (get-iterate-temp))
-                 (generator (second clause)))
-                (setq
-                 let-bindings
-                 (list (list gvar generator)))
-                (setq let-body `(funcall ,gvar #'(lambda nil ,finish-form)))))
-           (push (mv-setq (copy-list vars)
-                        let-body)
-                 update-forms)
-           (dolist (v vars)
-               (declare (ignore v))
-                                               ; Pop off the vars we have now
-                                               ; bound from the list of vars
-                                               ; to watch out for--we'll bind
-                                               ; them right now
-               (pop bound-vars))
-           (setq bindings
-                 (nconc bindings let-bindings
-                        (cond (extra-body
-                                               ; There was some computation to
-                                               ; do after the bindings--here's
-                                               ; our chance
-                               (cons (list (first vars)
-                                           `(progn ,@extra-body nil))
-                                     (rest vars)))
-                              (t vars))))))))))
-  (do ((tail body (cdr tail)))
-      ((not (and (consp tail)
-                 (consp (car tail))
-                 (eq (caar tail)
-                     'declare)))
-       
-       ;; TAIL now points at first non-declaration.  If there were
-       ;; declarations, pop them off so they appear in the right place
-       (unless (eq tail body)
-           (setq iterate-decls (ldiff body tail))
-           (setq body tail))))
-  `(block ,block-name
-       (let* ,bindings ,@(and generator-decls
-                              `((declare ,@generator-decls)))
-             ,@iterate-decls
-             ,@leftover-body
-             (loop ,@(nreverse update-forms)
-                   ,@body)))))
-
-(defun expand-into-let (clause parent-name env)
-       
-       ;; Return values: Body, LET[*], bindings, localdecls, otherdecls, extra
-       ;; body, where BODY is a single form.  If multiple forms in a LET, the
-       ;; preceding forms are returned as extra body.  Returns :ABORT if it
-       ;; issued a punt warning.
-       (prog ((expansion clause)
-              expandedp binding-type let-bindings let-body)
-             expand
-             (multiple-value-setq (expansion expandedp)
-                    (macroexpand-1 expansion env))
-             (cond ((not (consp expansion))
-                                               ; Shouldn't happen
-                    )
-                   ((symbolp (setq binding-type (first expansion)))
-                    (case binding-type
-                        ((let let*) 
-                           (setq let-bindings (second expansion))
-                                               ; List of variable bindings
-                           (setq let-body (cddr expansion))
-                           (go handle-let))))
-                   ((and (consp binding-type)
-                         (eq (car binding-type)
-                             'lambda)
-                         (not (find-if #'(lambda (x)
-                                                (member x lambda-list-keywords)
-                                                )
-                                     (setq let-bindings (second binding-type)))
-                              )
-                         (eql (length (second expansion))
-                              (length let-bindings))
-                         (null (cddr expansion)))
-                                               ; A simple LAMBDA form can be
-                                               ; treated as LET
-                    (setq let-body (cddr binding-type))
-                    (setq let-bindings (mapcar #'list let-bindings (second
-                                                                    expansion))
-                          )
-                    (setq binding-type 'let)
-                    (go handle-let)))
-             
-             ;; Fall thru if not a LET 
-             (cond (expandedp                  ; try expanding again
-                          (go expand))
-                   (t                          ; Boring--return form as the
-                                               ; body
-                      (return expansion)))
-             handle-let
-             (return (let ((locals (variables-from-let let-bindings))
-                           extra-body specials)
-                          (multiple-value-bind
-                           (localdecls otherdecls let-body)
-                           (parse-declarations let-body locals)
-                           (cond ((setq specials (extract-special-bindings
-                                                  locals localdecls))
-                                  (maybe-warn (cond ((find-if #'variable-globally-special-p
-                                                            specials)
-                                               ; This could be the fault of a
-                                               ; user proclamation
-                                                     :user)
-                                                    (t :definition))
-                                         
-          "Couldn't optimize ~S because expansion of ~S binds specials ~(~S ~)"
-                                         parent-name clause specials)
-                                  :abort)
-                                 (t (values (cond ((not (consp let-body))
-                                                   
-                                               ; Null body of LET?  unlikely,
-                                               ; but someone else will likely
-                                               ; complain
-                                                   nil)
-                                                  ((null (cdr let-body))
-                                                   
-                                               ; A single expression, which we
-                                               ; hope is (function
-                                               ; (lambda...))
-                                                   (first let-body))
-                                                  (t 
-
-                          ;; More than one expression.  These are forms to
-                          ;; evaluate after the bindings but before the
-                          ;; generator form is returned.  Save them to
-                          ;; evaluate in the next convenient place.  Note that
-                          ;; this is ok, as there is no construct that can
-                          ;; cause a LET to return prematurely (without
-                          ;; returning also from some surrounding construct).
-                                                     (setq extra-body
-                                                           (butlast let-body))
-                                                     (car (last let-body))))
-                                           binding-type let-bindings localdecls
-                                           otherdecls extra-body))))))))
-
-(defun variables-from-let (bindings)
-       
-       ;; Return a list of the variables bound in the first argument to LET[*].
-       (mapcar #'(lambda (binding)
-                        (if (consp binding)
-                            (first binding)
-                            binding))
-              bindings))
-
-(defun iterate-transform-body (let-body iterate-env renamed-vars finish-arg 
-                                     finish-form bound-vars clause)
-       
-
-;;; This is the second major transformation for a single iterate clause. 
-;;; LET-BODY is the body of the iterator after we have extracted its local
-;;; variables and declarations.  We have two main tasks: (1) Substitute
-;;; internal temporaries for occurrences of the LET variables; the alist
-;;; RENAMED-VARS specifies this transformation.  (2) Substitute evaluation of
-;;; FINISH-FORM for any occurrence of (funcall FINISH-ARG).  Along the way, we
-;;; check for forms that would invalidate these transformations: occurrence of
-;;; FINISH-ARG outside of a funcall, and free reference to any element of
-;;; BOUND-VARS.  CLAUSE & TYPE are the original ITERATE clause and its type
-;;; (ITERATE or ITERATE*), for purpose of error messages.  On success, we
-;;; return the transformed body; on failure, :ABORT.
-
-       (walk-form let-body iterate-env
-              #'(lambda (form context env)
-                       (declare (ignore context))
-                       
-                       ;; Need to substitute RENAMED-VARS, as well as turn
-                       ;; (FUNCALL finish-arg) into the finish form
-                       (cond ((symbolp form)
-                              (let (renaming)
-                                   (cond ((and (eq form finish-arg)
-                                               (variable-same-p form env 
-                                                      iterate-env))
-                                               ; An occurrence of the finish
-                                               ; arg outside of FUNCALL
-                                               ; context--I can't handle this
-                                          (maybe-warn :definition "Couldn't optimize iterate form because generator ~S does something with its FINISH arg besides FUNCALL it."
-                                                 (second clause))
-                                          (return-from iterate-transform-body 
-                                                 :abort))
-                                         ((and (setq renaming (assoc form 
-                                                                   renamed-vars
-                                                                     ))
-                                               (variable-same-p form env 
-                                                      iterate-env))
-                                               ; Reference to one of the vars
-                                               ; we're renaming
-                                          (cdr renaming))
-                                         ((and (member form bound-vars)
-                                               (variable-same-p form env 
-                                                      iterate-env))
-                                               ; FORM is a var that is bound
-                                               ; in this same ITERATE, or
-                                               ; bound later in this ITERATE*.
-                                               ; This is a conflict.
-                                          (maybe-warn :user "Couldn't optimize iterate form because generator ~S is closed over ~S, in conflict with a subsequent iteration variable."
-                                                 (second clause)
-                                                 form)
-                                          (return-from iterate-transform-body 
-                                                 :abort))
-                                         (t form))))
-                             ((and (consp form)
-                                   (eq (first form)
-                                       'funcall)
-                                   (eq (second form)
-                                       finish-arg)
-                                   (variable-same-p (second form)
-                                          env iterate-env))
-                                               ; (FUNCALL finish-arg) =>
-                                               ; finish-form
-                              (unless (null (cddr form))
-                                  (maybe-warn :definition 
-        "Generator for ~S applied its finish arg to > 0 arguments ~S--ignored."
-                                         (second clause)
-                                         (cddr form)))
-                              finish-form)
-                             (t form)))))
-
-(defun
- parse-declarations
- (tail locals)
- 
- ;; Extract the declarations from the head of TAIL and divide them into 2
- ;; classes: declares about variables in the list LOCALS, and all other
- ;; declarations.  Returns 3 values: those 2 lists plus the remainder of TAIL.
- (let
-  (localdecls otherdecls form)
-  (loop
-   (unless (and tail (consp (setq form (car tail)))
-                (eq (car form)
-                    'declare))
-       (return (values localdecls otherdecls tail)))
-   (mapc
-    #'(lambda
-       (decl)
-       (case (first decl)
-           ((inline notinline optimize) 
-                                               ; These don't talk about vars
-              (push decl otherdecls))
-           (t                                  ; Assume all other kinds are
-                                               ; for vars
-              (let* ((vars (if (eq (first decl)
-                                   'type)
-                               (cddr decl)
-                               (cdr decl)))
-                     (l (intersection locals vars))
-                     other)
-                    (cond
-                     ((null l)
-                                               ; None talk about LOCALS
-                      (push decl otherdecls))
-                     ((null (setq other (set-difference vars l)))
-                                               ; All talk about LOCALS
-                      (push decl localdecls))
-                     (t                        ; Some of each
-                        (let ((head (cons 'type (and (eq (first decl)
-                                                         'type)
-                                                     (list (second decl))))))
-                             (push (append head other)
-                                   otherdecls)
-                             (push (append head l)
-                                   localdecls))))))))
-    (cdr form))
-   (pop tail))))
-
-(defun extract-special-bindings (vars decls)
-       
-       ;; Return the subset of VARS that are special, either globally or
-       ;; because of a declaration in DECLS
-       (let ((specials (remove-if-not #'variable-globally-special-p vars)))
-            (dolist (d decls)
-                (when (eq (car d)
-                          'special)
-                    (setq specials (union specials (intersection vars
-                                                          (cdr d))))))
-            specials))
-
-(defun function-lambda-p (form &optional nargs)
-       
-       ;; If FORM is #'(LAMBDA bindings . body) and bindings is of length
-       ;; NARGS, return the lambda expression
-       (let (args body)
-            (and (consp form)
-                 (eq (car form)
-                     'function)
-                 (consp (setq form (cdr form)))
-                 (null (cdr form))
-                 (consp (setq form (car form)))
-                 (eq (car form)
-                     'lambda)
-                 (consp (setq body (cdr form)))
-                 (listp (setq args (car body)))
-                 (or (null nargs)
-                     (eql (length args)
-                          nargs))
-                 form)))
-
-(defun
- rename-let-bindings
- (let-bindings binding-type env leftover-body &optional tempvarfn)
- 
- ;; Perform the alpha conversion required for "LET eversion" of (LET[*]
- ;; LET-BINDINGS . body)--rename each of the variables to an internal name. 
- ;; Returns 2 values: a new set of LET bindings and the alist of old var names
- ;; to new (so caller can walk the body doing the rest of the renaming). 
- ;; BINDING-TYPE is one of LET or LET*.  LEFTOVER-BODY is optional list of
- ;; forms that must be eval'ed before the first binding happens.  ENV is the
- ;; macro expansion environment, in case we have to walk a LET*.  TEMPVARFN is
- ;; a function of no args to return a temporary var; if omitted, we use
- ;; GENSYM.
- (let
-  (renamed-vars)
-  (values (mapcar #'(lambda (binding)
-                           (let ((valueform (cond ((not (consp binding))
-                                                   
-                                               ; No initial value
-                                                   nil)
-                                                  ((or (eq binding-type
-                                                           'let)
-                                                       (null renamed-vars))
-                                                   
-                                               ; All bindings are in parallel,
-                                               ; so none can refer to others
-                                                   (second binding))
-                                                  (t 
-                                               ; In a LET*, have to substitute
-                                               ; vars in the 2nd and
-                                               ; subsequent initialization
-                                               ; forms
-                                                     (rename-variables
-                                                      (second binding)
-                                                      renamed-vars env))))
-                                 (newvar (if tempvarfn
-                                             (funcall tempvarfn)
-                                             (gensym))))
-                                (push (cons (if (consp binding)
-                                                (first binding)
-                                                binding)
-                                            newvar)
-                                      renamed-vars)
-                                               ; Add new variable to the list
-                                               ; AFTER we have walked the
-                                               ; initial value form
-                                (when leftover-body
-                                    
-
-                          ;; Previous clause had some computation to do after
-                          ;; its bindings.  Here is the first opportunity to
-                          ;; do it
-                                    (setq valueform `(progn ,@leftover-body
-                                                            ,valueform))
-                                    (setq leftover-body nil))
-                                (list newvar valueform)))
-                 let-bindings)
-         renamed-vars)))
-
-(defun rename-variables (form alist env)
-       
-       ;; Walks FORM, renaming occurrences of the key variables in ALIST with
-       ;; their corresponding values.  ENV is FORM's environment, so we can
-       ;; make sure we are talking about the same variables.
-       (walk-form form env
-              #'(lambda (form context subenv)
-                       (declare (ignore context))
-                       (let (pair)
-                            (cond ((and (symbolp form)
-                                        (setq pair (assoc form alist))
-                                        (variable-same-p form subenv env))
-                                   (cdr pair))
-                                  (t form))))))
-
-(defun
- mv-setq
- (vars expr)
- 
- ;; Produces (MULTIPLE-VALUE-SETQ vars expr), except that I'll optimize some
- ;; of the simple cases for benefit of compilers that don't, and I don't care
- ;; what the value is, and I know that the variables need not be set in
- ;; parallel, since they can't be used free in EXPR
- (cond
-  ((null vars)
-                                               ; EXPR is a side-effect
-   expr)
-  ((not (consp vars))
-                                               ; This is an error, but I'll
-                                               ; let MULTIPLE-VALUE-SETQ
-                                               ; report it
-   `(multiple-value-setq ,vars ,expr))
-  ((and (listp expr)
-        (eq (car expr)
-            'values))
-   
-   ;; (mv-setq (a b c) (values x y z)) can be reduced to a parallel setq
-   ;; (psetq returns nil, but I don't care about returned value).  Do this
-   ;; even for the single variable case so that we catch (mv-setq (a) (values
-   ;; x y))
-   (pop expr)
-                                               ; VALUES
-   `(setq ,@(mapcon #'(lambda (tail)
-                             (list (car tail)
-                                   (cond ((or (cdr tail)
-                                              (null (cdr expr)))
-                                               ; One result expression for
-                                               ; this var
-                                          (pop expr))
-                                         (t    ; More expressions than vars,
-                                               ; so arrange to evaluate all
-                                               ; the rest now.
-                                            (cons 'prog1 expr)))))
-                   vars)))
-  ((null (cdr vars))
-                                               ; Simple one variable case
-   `(setq ,(car vars)
-          ,expr))
-  (t                                           ; General case--I know nothing
-     `(multiple-value-setq ,vars ,expr))))
-
-(defun variable-same-p (var env1 env2)
-       (eq (variable-lexical-p var env1)
-           (variable-lexical-p var env2)))
-
-(defun maybe-warn (type &rest warn-args)
-       
-       ;; Issue a warning about not being able to optimize this thing.  TYPE
-       ;; is one of :DEFINITION, meaning the definition is at fault, and
-       ;; :USER, meaning the user's code is at fault.
-       (when (case *iterate-warnings*
-                 ((nil) nil)
-                 ((:user) (eq type :user))
-                 (t t))
-           (apply #'warn warn-args)))
-
-
-;; Sample iterators
-
-
-(defmacro
- interval
- (&whole whole &key from downfrom to downto above below by type)
- (cond
-  ((and from downfrom)
-   (error "Can't use both FROM and DOWNFROM in ~S" whole))
-  ((cdr (remove nil (list to downto above below)))
-   (error "Can't use more than one limit keyword in ~S" whole))
-  (t
-   (let*
-    ((down (or downfrom downto above))
-     (limit (or to downto above below))
-     (inc (cond ((null by)
-                 1)
-                ((constantp by)
-                                               ; Can inline this increment
-                 by))))
-    `(let
-      ((from ,(or from downfrom 0))
-       ,@(and limit `((to ,limit)))
-       ,@(and (null inc)
-              `((by ,by))))
-      ,@(and type `((declare (type ,type from ,@(and limit '(to))
-                                   ,@(and (null inc)
-                                          `(by))))))
-      #'(lambda
-         (finish)
-         ,@(cond ((null limit)
-                                               ; We won't use the FINISH arg
-                  '((declare (ignore finish)))))
-         (prog1 ,(cond (limit                  ; Test the limit.  If ok,
-                                               ; return current value and
-                                               ; increment, else quit
-                              `(if (,(cond (above '>)
-                                           (below '<)
-                                           (down '>=)
-                                           (t '<=))
-                                    from to)
-                                   from
-                                   (funcall finish)))
-                       (t                      ; No test
-                          'from))
-             (setq from (,(if down
-                              '-
-                              '+)
-                         from
-                         ,(or inc 'by))))))))))
-
-(defmacro list-elements (list &key (by '#'cdr))
-       `(let ((tail ,list))
-             #'(lambda (finish)
-                      (prog1 (if (endp tail)
-                                 (funcall finish)
-                                 (first tail))
-                          (setq tail (funcall ,by tail))))))
-
-(defmacro list-tails (list &key (by '#'cdr))
-       `(let ((tail ,list))
-             #'(lambda (finish)
-                      (prog1 (if (endp tail)
-                                 (funcall finish)
-                                 tail)
-                          (setq tail (funcall ,by tail))))))
-
-(defmacro
- elements
- (sequence)
- "Generates successive elements of SEQUENCE, with second value being the index.  Use (ELEMENTS (THE type arg)) if you care about the type."
- (let*
-  ((type (and (consp sequence)
-              (eq (first sequence)
-                  'the)
-              (second sequence)))
-   (accessor (if type
-                 (sequence-accessor type)
-                 'elt))
-   (listp (eq type 'list)))
-  
-  ;; If type is given via THE, we may be able to generate a good accessor here
-  ;; for the benefit of implementations that aren't smart about (ELT (THE
-  ;; STRING FOO)).  I'm not bothering to keep the THE inside the body,
-  ;; however, since I assume any compiler that would understand (AREF (THE
-  ;; SIMPLE-ARRAY S)) would also understand that (AREF S) is the same when I
-  ;; bound S to (THE SIMPLE-ARRAY foo) and never modified it.
-  
-  ;; If sequence is declared to be a list, it's better to cdr down it, so we
-  ;; have some extra cases here.  Normally folks would write LIST-ELEMENTS,
-  ;; but maybe they wanted to get the index for free...
-  `(let* ((index 0)
-          (s ,sequence)
-          ,@(and (not listp)
-                 '((size (length s)))))
-         #'(lambda (finish)
-                  (values (cond ,(if listp
-                                     '((not (endp s))
-                                       (pop s))
-                                     `((< index size)
-                                       (,accessor s index)))
-                                (t (funcall finish)))
-                         (prog1 index
-                             (setq index (1+ index))))))))
-
-(defmacro
- plist-elements
- (plist)
- "Generates each time 2 items, the indicator and the value."
- `(let ((tail ,plist))
-       #'(lambda (finish)
-                (values (if (endp tail)
-                            (funcall finish)
-                            (first tail))
-                       (prog1 (if (endp (setq tail (cdr tail)))
-                                  (funcall finish)
-                                  (first tail))
-                           (setq tail (cdr tail)))))))
-
-(defun sequence-accessor (type)
-       
-       ;; returns the function with which most efficiently to make accesses to
-       ;; a sequence of type TYPE.
-       (case (if (consp type)
-                                               ; e.g., (VECTOR FLOAT *)
-                 (car type)
-                 type)
-           ((array simple-array vector) 'aref)
-           (simple-vector 'svref)
-           (string 'char)
-           (simple-string 'schar)
-           (bit-vector 'bit)
-           (simple-bit-vector 'sbit)
-           (t 'elt)))
-
-
-;; These "iterators" may be withdrawn
-
-
-(defmacro eachtime (expr)
-       `#'(lambda (finish)
-                 (declare (ignore finish))
-                 ,expr))
-
-(defmacro while (expr)
-       `#'(lambda (finish)
-                 (unless ,expr (funcall finish))))
-
-(defmacro until (expr)
-       `#'(lambda (finish)
-                 (when ,expr (funcall finish))))
-
-                                               ; GATHERING macro
-
-
-(defmacro gathering (clauses &body body &environment env)
-       (or (optimize-gathering-form clauses body env)
-           (simple-expand-gathering-form clauses body env)))
-
-(defmacro with-gathering (clauses gather-body &body use-body)
-       "Binds the variables specified in CLAUSES to the result of (GATHERING clauses gather-body) and evaluates the forms in USE-BODY inside that contour."
-       
-       ;; We may optimize this a little better later for those compilers that
-       ;; don't do a good job on (m-v-bind vars (... (values ...)) ...).
-       `(multiple-value-bind ,(mapcar #'car clauses)
-               (gathering ,clauses ,gather-body)
-               ,@use-body))
-
-(defun
- simple-expand-gathering-form
- (clauses body env)
- (declare (ignore env))
- 
- ;; The "formal semantics" of GATHERING.  We use this only in cases that can't
- ;; be optimized.
- (let
-  ((acc-names (mapcar #'first (if (symbolp clauses)
-                                               ; Shorthand using anonymous
-                                               ; gathering site
-                                  (setq clauses `((*anonymous-gathering-site*
-                                                   (,clauses))))
-                                  clauses)))
-   (realizer-names (mapcar #'(lambda (binding)
-                                    (declare (ignore binding))
-                                    (gensym))
-                          clauses)))
-  `(multiple-value-call
-    #'(lambda
-       ,(mapcan #'list acc-names realizer-names)
-       (flet ((gather (value &optional (accumulator *anonymous-gathering-site*)
-                             )
-                     (funcall accumulator value)))
-             ,@body
-             (values ,@(mapcar #'(lambda (rname)
-                                        `(funcall ,rname))
-                              realizer-names))))
-    ,@(mapcar #'second clauses))))
-
-(defvar *active-gatherers* nil 
-       "List of GATHERING bindings currently active during macro expansion)")
-
-(defvar *anonymous-gathering-site* nil "Variable used in formal expansion of an abbreviated GATHERING form (one with anonymous gathering site)."
-       )
-
-(defun
- optimize-gathering-form
- (clauses body gathering-env)
- (let*
-  (acc-info leftover-body top-bindings finish-forms top-decls)
-  (dolist (clause (if (symbolp clauses)
-                                               ; A shorthand
-                      `((*anonymous-gathering-site* (,clauses)))
-                      clauses))
-      (multiple-value-bind
-       (let-body binding-type let-bindings localdecls otherdecls extra-body)
-       (expand-into-let (second clause)
-              'gathering gathering-env)
-       (prog*
-        ((acc-var (first clause))
-         renamed-vars accumulator realizer)
-        (when (and (consp let-body)
-                   (eq (car let-body)
-                       'values)
-                   (consp (setq let-body (cdr let-body)))
-                   (setq accumulator (function-lambda-p (car let-body)))
-                   (consp (setq let-body (cdr let-body)))
-                   (setq realizer (function-lambda-p (car let-body)
-                                         0))
-                   (null (cdr let-body)))
-            
-            ;; Macro returned something of the form (VALUES #'(lambda (value)
-            ;; ...) #'(lambda () ...)), a function to accumulate values and a
-            ;; function to realize the result.
-            (when binding-type
-                
-                ;; Gatherer expanded into a LET
-                (cond (otherdecls (maybe-warn :definition "Couldn't optimize GATHERING clause ~S because its expansion carries declarations about more than the bound variables: ~S"
-                                         (second clause)
-                                         `(declare ,@otherdecls))
-                             (go punt)))
-                (when let-bindings
-                    
-                    ;; The first transformation we want to perform is a
-                    ;; variant of "LET-eversion": turn (mv-bind (acc real)
-                    ;; (let (..bindings..) (values #'(lambda ...) #'(lambda
-                    ;; ...))) ..body..) into (let* (..bindings.. (acc
-                    ;; #'(lambda ...)) (real #'(lambda ...))) ..body..).  This
-                    ;; transformation is valid if nothing in body refers to
-                    ;; any of the bindings, something we can assure by
-                    ;; alpha-converting the inner let (substituting new names
-                    ;; for each var).  Of course, none of those vars can be
-                    ;; special, but we already checked for that above.
-                    (multiple-value-setq (let-bindings renamed-vars)
-                           (rename-let-bindings let-bindings binding-type 
-                                  gathering-env leftover-body))
-                    (setq top-bindings (nconc top-bindings let-bindings))
-                    (setq leftover-body nil)
-                                               ; If there was any leftover
-                                               ; from previous, it is now
-                                               ; consumed
-                    ))
-            (setq leftover-body (nconc leftover-body extra-body))
-                                               ; Computation to do after these
-                                               ; bindings
-            (push (cons acc-var (rename-and-capture-variables accumulator 
-                                       renamed-vars gathering-env))
-                  acc-info)
-            (setq realizer (rename-variables realizer renamed-vars 
-                                  gathering-env))
-            (push (cond ((null (cdddr realizer))
-                                               ; Simple (LAMBDA () expr) =>
-                                               ; expr
-                         (third realizer))
-                        (t                     ; There could be declarations
-                                               ; or something, so leave as a
-                                               ; LET
-                           (cons 'let (cdr realizer))))
-                  finish-forms)
-            (unless (null localdecls)
-                                               ; Declarations about the LET
-                                               ; variables also has to
-                                               ; percolate up
-                (setq top-decls (nconc top-decls (sublis renamed-vars 
-                                                        localdecls))))
-            (return))
-        (maybe-warn :definition "Couldn't optimize GATHERING clause ~S because its expansion is not of the form (VALUES #'(LAMBDA ...) #'(LAMBDA () ...))"
-               (second clause))
-        punt
-        (let
-         ((gs (gensym))
-          (expansion `(multiple-value-list ,(second clause))))
-                                               ; Slow way--bind gensym to the
-                                               ; macro expansion, and we will
-                                               ; funcall it in the body
-         (push (list acc-var gs)
-               acc-info)
-         (push `(funcall (cadr ,gs))
-               finish-forms)
-         (setq
-          top-bindings
-          (nconc
-           top-bindings
-           (list (list gs (cond (leftover-body
-                                 `(progn ,@(prog1 leftover-body
-                                                  (setq leftover-body nil))
-                                         ,expansion))
-                                (t expansion))))))))))
-  (setq body (walk-gathering-body body gathering-env acc-info))
-  (cond ((eq body :abort)
-                                               ; Couldn't finish expansion
-         nil)
-        (t `(let* ,top-bindings
-                  ,@(and top-decls `((declare ,@top-decls)))
-                  ,body
-                  ,(cond ((null (cdr finish-forms))
-                                               ; just a single value
-                          (car finish-forms))
-                         (t `(values ,@(reverse finish-forms)))))))))
-
-(defun rename-and-capture-variables (form alist env)
-       
-       ;; Walks FORM, renaming occurrences of the key variables in ALIST with
-       ;; their corresponding values, and capturing any other free variables. 
-       ;; Returns a list of the new form and the list of other closed-over
-       ;; vars.  ENV is FORM's environment, so we can make sure we are talking
-       ;; about the same variables.
-       (let (closed)
-            (list (walk-form
-                   form env
-                   #'(lambda (form context subenv)
-                            (declare (ignore context))
-                            (let (pair)
-                                 (cond ((or (not (symbolp form))
-                                            (not (variable-same-p form subenv 
-                                                        env)))
-                                               ; non-variable or one that has
-                                               ; been rebound
-                                        form)
-                                       ((setq pair (assoc form alist))
-                                               ; One to rename
-                                        (cdr pair))
-                                       (t      ; var is free
-                                          (pushnew form closed)
-                                          form)))))
-                  closed)))
-
-(defun
- walk-gathering-body
- (body gathering-env acc-info)
- 
- ;; Walk the body of (GATHERING (...) . BODY) in environment GATHERING-ENV. 
- ;; ACC-INFO is a list of information about each of the gathering "bindings"
- ;; in the form, in the form (var gatheringfn freevars env)
- (let
-  ((*active-gatherers* (nconc (mapcar #'car acc-info)
-                              *active-gatherers*)))
-  
-  ;; *ACTIVE-GATHERERS* tells us what vars are currently legal as GATHER
-  ;; targets.  This is so that when we encounter a GATHER not belonging to us
-  ;; we can know whether to warn about it.
-  (walk-form
-   (cons 'progn body)
-   gathering-env
-   #'(lambda
-      (form context env)
-      (declare (ignore context))
-      (let (info site)
-           (cond ((consp form)
-                  (cond
-                   ((not (eq (car form)
-                             'gather))
-                                               ; We only care about GATHER
-                    (when (and (eq (car form)
-                                   'function)
-                               (eq (cadr form)
-                                   'gather))
-                                               ; Passed as functional--can't
-                                               ; macroexpand
-                        (maybe-warn :user 
-                   "Can't optimize GATHERING because of reference to #'GATHER."
-                               )
-                        (return-from walk-gathering-body :abort))
-                    form)
-                   ((setq info (assoc (setq site (if (null (cddr form))
-                                                     
-                                                     '
-                                                     *anonymous-gathering-site*
-                                                     (third form)))
-                                      acc-info))
-                                               ; One of ours--expand (GATHER
-                                               ; value var).  INFO = (var
-                                               ; gatheringfn freevars env)
-                    (unless (null (cdddr form))
-                           (warn "Extra arguments (> 2) in ~S discarded." form)
-                           )
-                    (let ((fn (second info)))
-                         (cond ((symbolp fn)
-                                               ; Unoptimized case--just call
-                                               ; the gatherer.  FN is the
-                                               ; gensym that we bound to the
-                                               ; list of two values returned
-                                               ; from the gatherer.
-                                `(funcall (car ,fn)
-                                        ,(second form)))
-                               (t              ; FN = (lambda (value) ...)
-                                  (dolist (s (third info))
-                                      (unless (or (variable-same-p s env 
-                                                         gathering-env)
-                                                  (and (variable-special-p
-                                                        s env)
-                                                       (variable-special-p
-                                                        s gathering-env)))
-                                          
-
-                          ;; Some var used free in the LAMBDA form has been
-                          ;; rebound between here and the parent GATHERING
-                          ;; form, so can't substitute the lambda.  Ok if it's
-                          ;; a special reference both here and in the LAMBDA,
-                          ;; because then it's not closed over.
-                                          (maybe-warn :user "Can't optimize GATHERING because the expansion closes over the variable ~S, which is rebound around a GATHER for it."
-                                                 s)
-                                          (return-from walk-gathering-body 
-                                                 :abort)))
-                                  
-
-                          ;; Return ((lambda (value) ...) actual-value).  In
-                          ;; many cases we could simplify this further by
-                          ;; substitution, but we'd have to be careful (for
-                          ;; example, we would need to alpha-convert any LET
-                          ;; we found inside).  Any decent compiler will do it
-                          ;; for us.
-                                  (list fn (second form))))))
-                   ((and (setq info (member site *active-gatherers*))
-                         (or (eq site '*anonymous-gathering-site*)
-                             (variable-same-p site env (fourth info))))
-                                               ; Some other GATHERING will
-                                               ; take care of this form, so
-                                               ; pass it up for now. 
-                                               ; Environment check is to make
-                                               ; sure nobody shadowed it
-                                               ; between here and there
-                    form)
-                   (t                          ; Nobody's going to handle it
-                      (if (eq site '*anonymous-gathering-site*)
-                                               ; More likely that she forgot
-                                               ; to mention the site than
-                                               ; forget to write an anonymous
-                                               ; gathering.
-                          (warn "There is no gathering site specified in ~S." 
-                                form)
-                          (warn 
-             "The site ~S in ~S is not defined in an enclosing GATHERING form."
-                                site form))
-                                               ; Turn it into something else
-                                               ; so we don't warn twice in the
-                                               ; nested case
-                      `(%orphaned-gather ,@(cdr form)))))
-                 ((and (symbolp form)
-                       (setq info (assoc form acc-info))
-                       (variable-same-p form env gathering-env))
-                                               ; A variable reference to a
-                                               ; gather binding from
-                                               ; environment TEM
-                  (maybe-warn :user "Can't optimize GATHERING because site variable ~S is used outside of a GATHER form."
-                         form)
-                  (return-from walk-gathering-body :abort))
-                 (t form)))))))
-
-
-;; Sample gatherers
-
-
-(defmacro
- collecting
- (&key initial-value)
- `(let* ((head ,initial-value)
-         (tail ,(and initial-value `(last head))))
-        (values #'(lambda (value)
-                         (if (null head)
-                             (setq head (setq tail (list value)))
-                             (setq tail (cdr (rplacd tail (list value))))))
-               #'(lambda nil head))))
-
-(defmacro joining (&key initial-value)
-       `(let ((result ,initial-value))
-             (values #'(lambda (value)
-                              (setq result (nconc result value)))
-                    #'(lambda nil result))))
-
-(defmacro
- maximizing
- (&key initial-value)
- `(let ((result ,initial-value))
-       (values
-        #'(lambda (value)
-                 (when ,(cond ((and (constantp initial-value)
-                                    (not (null (eval initial-value))))
-                                               ; Initial value is given and we
-                                               ; know it's not NIL, so leave
-                                               ; out the null check
-                               '(> value result))
-                              (t '(or (null result)
-                                      (> value result))))
-                       (setq result value)))
-        #'(lambda nil result))))
-
-(defmacro
- minimizing
- (&key initial-value)
- `(let ((result ,initial-value))
-       (values
-        #'(lambda (value)
-                 (when ,(cond ((and (constantp initial-value)
-                                    (not (null (eval initial-value))))
-                                               ; Initial value is given and we
-                                               ; know it's not NIL, so leave
-                                               ; out the null check
-                               '(< value result))
-                              (t '(or (null result)
-                                      (< value result))))
-                       (setq result value)))
-        #'(lambda nil result))))
-
-(defmacro summing (&key (initial-value 0))
-       `(let ((sum ,initial-value))
-             (values #'(lambda (value)
-                              (setq sum (+ sum value)))
-                    #'(lambda nil sum))))
-
-                                               ; Easier to read expanded code
-                                               ; if PROG1 gets left alone
-
-
-(define-walker-template prog1 (nil return walker::repeat (eval)))
-
diff --git a/pcl/macros.lisp b/pcl/macros.lisp
index f19dafd9d490c635803f05e63e433ccfdb91bdc1..4424a059d05b0b43f47df257eb54658b32ac936c 100644
--- a/pcl/macros.lisp
+++ b/pcl/macros.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/macros.lisp,v 1.17 2002/08/24 13:46:52 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/macros.lisp,v 1.18 2002/08/26 02:23:14 pmai Exp $")
 ;;;
 ;;; Macros global variable definitions, and other random support stuff used
 ;;; by the rest of the system.
@@ -113,7 +113,7 @@
 		(loop (cond ((not (listp form))
 			     (return-from outer nil))
 			    ((eq (car form) 'declare)
-			     (return-from inner 't))
+			     (return-from inner t))
 			    (t
 			     (multiple-value-bind (newform macrop)
 				  (macroexpand-1 form environment)
@@ -166,17 +166,6 @@
 	 (progn (setf ,alist (cons (,make-entry-fn ,key) ,alist))
 		(car ,alist)))))
 
-(defmacro collecting-once (&key initial-value)
-   `(let* ((head ,initial-value)
-           (tail ,(and initial-value `(last head))))
-          (values #'(lambda (value)
-                           (if (null head)
-                               (setq head (setq tail (list value)))
-			       (unless (memq value head)
-				 (setq tail
-				       (cdr (rplacd tail (list value)))))))
-		  #'(lambda nil head))))
-
 (defmacro doplist ((key val) plist &body body &environment env)
   (multiple-value-bind (doc decls bod)
       (extract-declarations body env)
@@ -352,33 +341,6 @@
       (setf (find-class-cell-predicate (find-class-cell symbol)) new-value)
       (error "~S is not a legal class name." symbol)))
 
-(defmacro gathering1 (gatherer &body body)
-  `(gathering ((.gathering1. ,gatherer))
-     (macrolet ((gather1 (x) `(gather ,x .gathering1.)))
-       ,@body)))
-
-
-;;;
-;;; These are augmented definitions of list-elements and list-tails from
-;;; iterate.lisp.  These versions provide the extra :by keyword which can
-;;; be used to specify the step function through the list.
-;;;
-(defmacro *list-elements (list &key (by #'cdr))
-  `(let ((tail ,list))
-     #'(lambda (finish)
-	 (if (endp tail)
-	     (funcall finish)
-	     (prog1 (car tail)
-	            (setq tail (funcall ,by tail)))))))
-
-(defmacro *list-tails (list &key (by #'cdr))
-   `(let ((tail ,list))
-      #'(lambda (finish)
-          (prog1 (if (endp tail)
-		     (funcall finish)
-		     tail)
-	         (setq tail (funcall ,by tail))))))
-
 (defmacro function-funcall (form &rest args)
   `(funcall (the function ,form) ,@args))
 
@@ -391,7 +353,7 @@
 (defvar *redefined-functions* nil)
 
 (defmacro original-definition (name)
-  `(get ,name ':definition-before-pcl))
+  `(get ,name :definition-before-pcl))
 
 (defun redefine-function (name new)
   (pushnew name *redefined-functions*)
diff --git a/pcl/methods.lisp b/pcl/methods.lisp
index fb2e0f6d019053d3f44af2156c7488f2f1cdc635..17ace2a815257fd8137b452bf4901022dd3afb8f 100644
--- a/pcl/methods.lisp
+++ b/pcl/methods.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.14 2001/03/13 15:49:48 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.15 2002/08/26 02:23:15 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -444,12 +444,12 @@
 	  (when original
 	    (add-named-method function-name
 			      ()
-			      (make-list nrequireds :initial-element 't)
+			      (make-list nrequireds :initial-element t)
 			      arglist
 			      (list :function
-				    #'(lambda (args next-methods)
-					(declare (ignore next-methods))
-					(apply original args)))))
+				    (lambda (args next-methods)
+				      (declare (ignore next-methods))
+				      (apply original args)))))
 	  generic-function))))
 
 
@@ -523,10 +523,10 @@
     ;; in the usual sort of way.  For efficiency don't bother to
     ;; keep specialized-argument-positions sorted, rather depend
     ;; on our caller to do that.
-    (iterate ((type-spec (list-elements (method-specializers method)))
-              (pos (interval :from 0)))
-      (unless (eq type-spec *the-class-t*)
-	(pushnew pos specialized-argument-positions)))
+    (loop for type-spec in (method-specializers method)
+	  and pos from 0
+	  unless (eq type-spec *the-class-t*) do
+	    (pushnew pos specialized-argument-positions))
     ;; Finally merge the values for this method into the values
     ;; for the exisiting methods and return them.  Note that if
     ;; num-of-requireds is NIL it means this is the first method
@@ -537,12 +537,10 @@
             specialized-argument-positions)))
 
 (defun make-discriminating-function-arglist (number-required-arguments restp)
-  (nconc (gathering ((args (collecting)))
-           (iterate ((i (interval :from 0 :below number-required-arguments)))
-             (gather (intern (format nil "Discriminating Function Arg ~D" i))
-		     args)))
+  (nconc (loop for i below number-required-arguments
+	       collect (intern (format nil "Discriminating Function Arg ~D" i)))
          (when restp
-               `(&rest ,(intern "Discriminating Function &rest Arg")))))
+	   (list '&rest (intern "Discriminating Function &rest Arg")))))
 
 
 ;;;
@@ -670,10 +668,10 @@
    (types-from-arguments generic-function classes 'class-eq)))
 
 (defun proclaim-incompatible-superclasses (classes)
-  (setq classes (mapcar #'(lambda (class)
-			    (if (symbolp class)
-				(find-class class)
-				class))
+  (setq classes (mapcar (lambda (class)
+			  (if (symbolp class)
+			      (find-class class)
+			      class))
 			classes))
   (dolist (class classes)
     (dolist (other-class classes)
@@ -737,7 +735,7 @@
 		 (make-internal-reader-method-function
 		  'standard-generic-function 'arg-info)
 		 t)))
-	#'(lambda (&rest args) (funcall mf args nil))))
+	(lambda (&rest args) (funcall mf args nil))))
 
 (defun types-from-arguments (generic-function arguments &optional type-modifier)
   (multiple-value-bind (nreq applyp metatypes nkeys arg-info)
@@ -757,7 +755,7 @@
 (defun get-wrappers-from-classes (nkeys wrappers classes metatypes)
   (let* ((w wrappers) (w-tail w) (mt-tail metatypes))
     (dolist (class (if (listp classes) classes (list classes)))
-      (unless (eq 't (car mt-tail))
+      (unless (eq t (car mt-tail))
 	(let ((c-w (class-wrapper class)))
 	  (unless c-w (return-from get-wrappers-from-classes nil))
 	  (if (eql nkeys 1)
@@ -783,13 +781,13 @@
 			 :constant-value)))
 
 (defun default-secondary-dispatch-function (generic-function)
-  #'(lambda (&rest args)
-      #+copy-&rest-arg (setq args (copy-list args))
-      (let ((methods (compute-applicable-methods generic-function args)))
-	(if methods
-	    (let ((emf (get-effective-method-function generic-function methods)))
-	      (invoke-emf emf args))
-	    (apply #'no-applicable-method generic-function args)))))
+  (lambda (&rest args)
+    #+copy-&rest-arg (setq args (copy-list args))
+    (let ((methods (compute-applicable-methods generic-function args)))
+      (if methods
+	  (let ((emf (get-effective-method-function generic-function methods)))
+	    (invoke-emf emf args))
+	  (apply #'no-applicable-method generic-function args)))))
 
 (defun list-eq (x y)
   (loop (when (atom x) (return (eq x y)))
@@ -820,8 +818,8 @@
 (defun update-all-c-a-m-gf-info (c-a-m-gf)
   (let ((methods (generic-function-methods c-a-m-gf)))
     (if (and *old-c-a-m-gf-methods*
-	     (every #'(lambda (old-method)
-			(member old-method methods))
+	     (every (lambda (old-method)
+		      (member old-method methods))
 		    *old-c-a-m-gf-methods*))
 	(let ((gfs-to-do nil)
 	      (gf-classes-to-do nil))
@@ -832,11 +830,11 @@
 		    (pushnew (specializer-object specl) gfs-to-do)
 		    (pushnew (specializer-class specl) gf-classes-to-do)))))
 	  (map-all-generic-functions 
-	   #'(lambda (gf)
-	       (when (or (member gf gfs-to-do)
-			 (dolist (class gf-classes-to-do nil)
-			   (member class (class-precedence-list (class-of gf)))))
-		 (update-c-a-m-gf-info gf)))))
+	   (lambda (gf)
+	     (when (or (member gf gfs-to-do)
+		       (dolist (class gf-classes-to-do nil)
+			 (member class (class-precedence-list (class-of gf)))))
+	       (update-c-a-m-gf-info gf)))))
 	(map-all-generic-functions #'update-c-a-m-gf-info))
     (setq *old-c-a-m-gf-methods* methods)))
 
@@ -980,8 +978,8 @@
 		      (eq spec *the-class-structure-object*)))
 	     (let ((sc (class-direct-subclasses spec)))
 	       (when sc
-		 (mapcan #'(lambda (class)
-			     (mec-all-classes-internal class precompute-p))
+		 (mapcan (lambda (class)
+			   (mec-all-classes-internal class precompute-p))
 			 sc))))))
 
 (defun mec-all-classes (spec precompute-p)
@@ -1004,8 +1002,8 @@
       (list nil)
       (let* ((car-all-classes (mec-all-classes (car spec-list) precompute-p))
 	     (all-class-lists (mec-all-class-lists (cdr spec-list) precompute-p)))
-	(mapcan #'(lambda (list)
-		    (mapcar #'(lambda (c) (cons c list)) car-all-classes))
+	(mapcan (lambda (list)
+		  (mapcar (lambda (c) (cons c list)) car-all-classes))
 		all-class-lists))))
 
 (defun make-emf-cache (generic-function valuep cache classes-list new-class)
@@ -1036,7 +1034,7 @@
 
 (defmacro class-test (arg class)
   (cond ((eq class *the-class-t*)
-	 't)
+	 t)
 	((eq class *the-class-slot-object*)
 	 `(not (lisp:typep (lisp:class-of ,arg) 'lisp:built-in-class)))
 	((eq class *the-class-std-object*)
@@ -1062,19 +1060,19 @@
 
 (defmacro scase (arg &rest clauses) ; This is case, but without gensyms
   `(let ((.case-arg. ,arg))
-     (cond ,@(mapcar #'(lambda (clause)
-			 (list* (cond ((null (car clause))
-				       nil)
-				      ((consp (car clause))
-				       (if (null (cdar clause))
-					   `(eql .case-arg. ',(caar clause))
-					   `(member .case-arg. ',(car clause))))
-				      ((member (car clause) '(t otherwise))
-				       `t)
-				      (t
-				       `(eql .case-arg. ',(car clause))))
-				nil
-				(cdr clause)))
+     (cond ,@(mapcar (lambda (clause)
+		       (list* (cond ((null (car clause))
+				     nil)
+				    ((consp (car clause))
+				     (if (null (cdar clause))
+					 `(eql .case-arg. ',(caar clause))
+					 `(member .case-arg. ',(car clause))))
+				    ((member (car clause) '(t otherwise))
+				     `t)
+				    (t
+				     `(eql .case-arg. ',(car clause))))
+			      nil
+			      (cdr clause)))
 		     clauses))))
 
 (defmacro mcase (arg &rest clauses) `(scase ,arg ,@clauses))
@@ -1084,49 +1082,49 @@
 	 (precedence (arg-info-precedence arg-info)))
     (generate-discrimination-net-internal 
      generic-function methods types
-     #'(lambda (methods known-types)
-	 (if (or sorted-p
-		 (block one-order-p
-		   (let ((sorted-methods nil))
-		     (map-all-orders 
-		      (copy-list methods) precedence
-		      #'(lambda (methods)
-			  (when sorted-methods (return-from one-order-p nil))
-			  (setq sorted-methods methods)))
-		     (setq methods sorted-methods))
-		   t))
-	     `(methods ,methods ,known-types)
-	     `(unordered-methods ,methods ,known-types)))
-     #'(lambda (position type true-value false-value)
-	 (let ((arg (dfun-arg-symbol position)))
-	   (if (eq (car type) 'eql)
-	       (let* ((false-case-p (and (consp false-value)
-					 (or (eq (car false-value) 'scase)
-					     (eq (car false-value) 'mcase))
-					 (eq arg (cadr false-value))))
-		      (false-clauses (if false-case-p
-					 (cddr false-value)
-					 `((t ,false-value))))
-		      (case-sym (if (and (dnet-methods-p true-value)
-					 (if false-case-p
-					     (eq (car false-value) 'mcase)
-					     (dnet-methods-p false-value)))
-				    'mcase
-				    'scase))
-		      (type-sym `(,(cadr type))))
-		 `(,case-sym ,arg
-		    (,type-sym ,true-value)
-		    ,@false-clauses))
-	       `(if ,(let ((arg (dfun-arg-symbol position)))
-		       (case (car type)
-			 (class    `(class-test    ,arg ,(cadr type)))
-			 (class-eq `(class-eq-test ,arg ,(cadr type)))))
-		    ,true-value
-		    ,false-value))))
+     (lambda (methods known-types)
+       (if (or sorted-p
+	       (block one-order-p
+		 (let ((sorted-methods nil))
+		   (map-all-orders 
+		    (copy-list methods) precedence
+		    (lambda (methods)
+		      (when sorted-methods (return-from one-order-p nil))
+		      (setq sorted-methods methods)))
+		   (setq methods sorted-methods))
+		 t))
+	   `(methods ,methods ,known-types)
+	   `(unordered-methods ,methods ,known-types)))
+     (lambda (position type true-value false-value)
+       (let ((arg (dfun-arg-symbol position)))
+	 (if (eq (car type) 'eql)
+	     (let* ((false-case-p (and (consp false-value)
+				       (or (eq (car false-value) 'scase)
+					   (eq (car false-value) 'mcase))
+				       (eq arg (cadr false-value))))
+		    (false-clauses (if false-case-p
+				       (cddr false-value)
+				       `((t ,false-value))))
+		    (case-sym (if (and (dnet-methods-p true-value)
+				       (if false-case-p
+					   (eq (car false-value) 'mcase)
+					   (dnet-methods-p false-value)))
+				  'mcase
+				  'scase))
+		    (type-sym `(,(cadr type))))
+	       `(,case-sym ,arg
+			   (,type-sym ,true-value)
+			   ,@false-clauses))
+	     `(if ,(let ((arg (dfun-arg-symbol position)))
+			(case (car type)
+			  (class    `(class-test    ,arg ,(cadr type)))
+			  (class-eq `(class-eq-test ,arg ,(cadr type)))))
+		  ,true-value
+		  ,false-value))))
      #'identity)))
 
 (defun class-from-type (type)
-  (if (or (atom type) (eq (car type) 't))
+  (if (or (atom type) (eq (car type) t))
       *the-class-t*
       (case (car type)
 	(and (dolist (type (cdr type) *the-class-t*)
@@ -1145,29 +1143,29 @@
 	 (classes-list nil))
     (generate-discrimination-net-internal 
      gf methods nil
-     #'(lambda (methods known-types)
-	 (when methods
-	   (when classes-list-p
-	     (push (mapcar #'class-from-type known-types) classes-list))
-	   (let ((no-eql-specls-p (not (methods-contain-eql-specializer-p methods))))
-	     (map-all-orders 
-	      methods precedence
-	      #'(lambda (methods)
-		  (get-secondary-dispatch-function1 
-		   gf methods known-types
-		   nil caching-p no-eql-specls-p))))))
-     #'(lambda (position type true-value false-value)
-	 (declare (ignore position type true-value false-value))
-	 nil)
-     #'(lambda (type)
-	 (if (and (consp type) (eq (car type) 'eql))
-	     `(class-eq ,(class-of (cadr type)))
-	     type)))
+     (lambda (methods known-types)
+       (when methods
+	 (when classes-list-p
+	   (push (mapcar #'class-from-type known-types) classes-list))
+	 (let ((no-eql-specls-p (not (methods-contain-eql-specializer-p methods))))
+	   (map-all-orders 
+	    methods precedence
+	    (lambda (methods)
+	      (get-secondary-dispatch-function1 
+	       gf methods known-types
+	       nil caching-p no-eql-specls-p))))))
+     (lambda (position type true-value false-value)
+       (declare (ignore position type true-value false-value))
+       nil)
+     (lambda (type)
+       (if (and (consp type) (eq (car type) 'eql))
+	   `(class-eq ,(class-of (cadr type)))
+	   type)))
     classes-list))
 
 ; we know that known-type implies neither new-type nor `(not ,new-type) 
 (defun augment-type (new-type known-type)
-  (if (or (eq known-type 't)
+  (if (or (eq known-type t)
 	  (eq (car new-type) 'eql))
       new-type
       (let ((so-far (if (and (consp known-type) (eq (car known-type) 'and))
@@ -1175,9 +1173,9 @@
 			(list known-type))))
 	(unless (eq (car new-type) 'not)
 	  (setq so-far
-		(mapcan #'(lambda (type)
-			    (unless (*subtypep new-type type)
-			      (list type)))
+		(mapcan (lambda (type)
+			  (unless (*subtypep new-type type)
+			    (list type)))
 			so-far)))
 	(if (null so-far)
 	    new-type
@@ -1193,7 +1191,7 @@
 	       (if p-tail
 		   (let* ((position (car p-tail))
 			  (known-type (or (nth position types) t)))
-		     (if (eq (nth position metatypes) 't)
+		     (if (eq (nth position metatypes) t)
 			 (do-column (cdr p-tail) contenders
 				    (cons (cons position known-type) known-types))
 			 (do-methods p-tail contenders 
@@ -1250,10 +1248,10 @@
 (defvar *case-table-limit* 10)
 
 (defun compute-mcase-parameters (case-list)
-  (unless (eq 't (caar (last case-list)))
+  (unless (eq t (caar (last case-list)))
     (error "The key for the last case arg to mcase was not T"))
   (let* ((eq-p (dolist (case case-list t)
-		 (unless (or (eq (car case) 't)
+		 (unless (or (eq (car case) t)
 			     (symbolp (caar case)))
 		   (return nil))))
 	 (len (1- (length case-list)))
@@ -1269,7 +1267,7 @@
     (list eq-p type)))
 
 (defmacro mlookup (key info default &optional eq-p type)
-  (unless (or (eq eq-p 't) (null eq-p))
+  (unless (or (eq eq-p t) (null eq-p))
     (error "Invalid eq-p argument"))
   (ecase type
     (:simple
@@ -1321,15 +1319,15 @@
 	  (case (car form)
 	    (mcase
 	     (let* ((mp (compute-mcase-parameters (cddr form)))
-		    (list (mapcar #'(lambda (clause)
-				      (let ((key (car clause))
-					    (meth (cadr clause)))
-					(cons (if (consp key) (car key) key)
-					      (methods-converter
-					       meth generic-function))))
+		    (list (mapcar (lambda (clause)
+				    (let ((key (car clause))
+					  (meth (cadr clause)))
+				      (cons (if (consp key) (car key) key)
+					    (methods-converter
+					     meth generic-function))))
 				  (cddr form)))
 		    (default (car (last list))))
-	       (list (list* ':mcase mp (nbutlast list))
+	       (list (list* :mcase mp (nbutlast list))
 		     (cdr default))))
 	    (t
 	     (default-constant-converter form))))))
@@ -1349,11 +1347,11 @@
 
 (defun convert-table (constant method-alist wrappers)
   (cond ((and (consp constant)
-	      (eq (car constant) ':mcase))
-	 (let ((alist (mapcar #'(lambda (k+m)
-				  (cons (car k+m)
-					(convert-methods (cdr k+m)
-							 method-alist wrappers)))
+	      (eq (car constant) :mcase))
+	 (let ((alist (mapcar (lambda (k+m)
+				(cons (car k+m)
+				      (convert-methods (cdr k+m)
+						       method-alist wrappers)))
 			      (cddr constant)))
 	       (mp (cadr constant)))
 	   (ecase (cadr mp)
@@ -1399,29 +1397,29 @@
 				     ,(make-emf-call metatypes applyp 'emf))))
 			 #'net-test-converter
 			 #'net-code-converter
-			 #'(lambda (form)
-			     (net-constant-converter form generic-function)))
-	#'(lambda (method-alist wrappers)
-	    (let* ((alist (list nil))
-		   (alist-tail alist))
-	      (dolist (constant constants)
-		(let* ((a (or (dolist (a alist nil)
-				(when (eq (car a) constant)
-				  (return a)))
-			      (cons constant
-				    (or (convert-table
-					 constant method-alist wrappers)
-					(convert-methods
-					 constant method-alist wrappers)))))
-		       (new (list a)))
-		  (setf (cdr alist-tail) new)
-		  (setf alist-tail new)))
-	      (let ((function (apply cfunction (mapcar #'cdr (cdr alist)))))
-		(if function-p
-		    function
-		    (make-fast-method-call
-		     :function (set-function-name function `(sdfun-method ,name))
-		     :arg-info fmc-arg-info))))))))))
+			 (lambda (form)
+			   (net-constant-converter form generic-function)))
+	(lambda (method-alist wrappers)
+	  (let* ((alist (list nil))
+		 (alist-tail alist))
+	    (dolist (constant constants)
+	      (let* ((a (or (dolist (a alist nil)
+			      (when (eq (car a) constant)
+				(return a)))
+			    (cons constant
+				  (or (convert-table
+				       constant method-alist wrappers)
+				      (convert-methods
+				       constant method-alist wrappers)))))
+		     (new (list a)))
+		(setf (cdr alist-tail) new)
+		(setf alist-tail new)))
+	    (let ((function (apply cfunction (mapcar #'cdr (cdr alist)))))
+	      (if function-p
+		  function
+		  (make-fast-method-call
+		   :function (set-function-name function `(sdfun-method ,name))
+		   :arg-info fmc-arg-info))))))))))
 
 (defvar *show-make-unordered-methods-emf-calls* nil)
 
@@ -1429,12 +1427,12 @@
   (when *show-make-unordered-methods-emf-calls*
     (format t "~&make-unordered-methods-emf ~s~%" 
 	    (generic-function-name generic-function)))
-  #'(lambda (&rest args)
-      #+copy-&rest-arg (setq args (copy-list args))
-      (let* ((types (types-from-arguments generic-function args 'eql))
-	     (smethods (sort-applicable-methods generic-function methods types))
-	     (emf (get-effective-method-function generic-function smethods)))
-	(invoke-emf emf args))))
+  (lambda (&rest args)
+    #+copy-&rest-arg (setq args (copy-list args))
+    (let* ((types (types-from-arguments generic-function args 'eql))
+	   (smethods (sort-applicable-methods generic-function methods types))
+	   (emf (get-effective-method-function generic-function smethods)))
+      (invoke-emf emf args))))
 
 
 ;;;
@@ -1464,7 +1462,7 @@
 ;;;
 ;;;   (defmethod compute-discriminating-function ((gf my-generic-function))
 ;;;     (let ((std (call-next-method)))
-;;;       #'(lambda (arg)
+;;;       (lambda (arg)
 ;;;            (print (list 'call-to-gf gf arg))
 ;;;            (funcall std arg))))
 ;;;
@@ -1491,7 +1489,7 @@
 ;;; itself in accordance with this protocol:
 ;;;
 ;;;   (defmethod compute-discriminating-function ((gf my-generic-function))
-;;;     #'(lambda (arg)
+;;;     (lambda (arg)
 ;;;         (cond (<some condition>
 ;;;                <store some info in the generic function>
 ;;;                (set-funcallable-instance-function
@@ -1504,11 +1502,11 @@
 ;;; Whereas this code would not be legal:
 ;;;
 ;;;   (defmethod compute-discriminating-function ((gf my-generic-function))
-;;;     #'(lambda (arg)
+;;;     (lambda (arg)
 ;;;         (cond (<some condition>
 ;;;                (set-funcallable-instance-function
 ;;;                  gf
-;;;                  #'(lambda (a) ..))
+;;;                  (lambda (a) ..))
 ;;;                (funcall gf arg))
 ;;;               (t
 ;;;                <call-a-method-of-gf>))))
@@ -1586,9 +1584,9 @@
   (multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords keyword-parameters)
       (analyze-lambda-list ll)
     (declare (ignore nreq nopt keysp restp allow-other-keys-p keywords))
-    (remove-if #'(lambda (s)
-		   (or (memq s keyword-parameters)
-		       (eq s '&allow-other-keys)))
+    (remove-if (lambda (s)
+		 (or (memq s keyword-parameters)
+		     (eq s '&allow-other-keys)))
 	       ll)))
 
 
@@ -1639,7 +1637,7 @@
       (cond ((eq arg '&optional)         (setq state 'optional))
 	    ((eq arg '&rest)             (setq state 'rest))
 	    ((eq arg '&key)              (setq state 'key))
-	    ((eq arg '&allow-other-keys) (setq allow-other-keys 't))
+	    ((eq arg '&allow-other-keys) (setq allow-other-keys t))
 	    ((memq arg lambda-list-keywords))
 	    (t
 	     (ecase state
diff --git a/pcl/pkg.lisp b/pcl/pkg.lisp
index 7d4dea718f8308224c6ad721c8d222396de90c35..13e027f7396c3c7e89819ea63ebd979c630bf6df 100644
--- a/pcl/pkg.lisp
+++ b/pcl/pkg.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.19 2002/08/24 16:20:25 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.20 2002/08/26 02:23:15 pmai Exp $")
 ;;;
 ;;; CMUCL 18a: Jan-1998 -- Changing to DEFPACKAGE.
 
@@ -42,14 +42,7 @@
 	   "VARIABLE-DECLARATION"
 	   "MACROEXPAND-ALL"))
 
-(defpackage "ITERATE" (:use :common-lisp :walker)
-  (:export "ITERATE" "ITERATE*" "GATHERING" "GATHER" "WITH-GATHERING"
-	   "INTERVAL" "ELEMENTS" "LIST-ELEMENTS" "LIST-TAILS"
-	   "PLIST-ELEMENTS" "EACHTIME" "WHILE" "UNTIL"
-	   "COLLECTING" "JOINING" "MAXIMIZING" "MINIMIZING" "SUMMING"
-	   "*ITERATE-WARNINGS*"))
-
-(defpackage "PCL" (:use :common-lisp :walker :iterate)
+(defpackage "PCL" (:use :common-lisp :walker)
   (:shadow "FIND-CLASS" "CLASS-NAME" "CLASS-OF"
 	   "CLASS" "BUILT-IN-CLASS" "STRUCTURE-CLASS"
 	   "STANDARD-CLASS")
diff --git a/pcl/slots-boot.lisp b/pcl/slots-boot.lisp
index 371ea967504e783eae7f800f96bf37e6fad34bca..cbf37af37defd3daa456764cbb6cbe13b4d20fc2 100644
--- a/pcl/slots-boot.lisp
+++ b/pcl/slots-boot.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.9 2002/08/13 21:13:58 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.10 2002/08/26 02:23:15 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -85,8 +85,8 @@
 
 (defun make-structure-slot-boundp-function (slotd)
   (let* ((reader (slot-definition-internal-reader-function slotd))
-	 (fun #'(lambda (object)
-		  (not (eq (funcall reader object) *slot-unbound*)))))
+	 (fun (lambda (object)
+		(not (eq (funcall reader object) *slot-unbound*)))))
     (declare (type function reader))
     fun))		    
 
@@ -120,21 +120,21 @@
   (set-function-name
    (etypecase index
      (fixnum (if fsc-p
-		 #'(lambda (instance)
-		     (let ((value (%instance-ref (fsc-instance-slots instance) index)))
-		       (if (eq value *slot-unbound*)
-			   (slot-unbound (class-of instance) instance slot-name)
-			   value)))
-		 #'(lambda (instance)
-		     (let ((value (%instance-ref (std-instance-slots instance) index)))
-		       (if (eq value *slot-unbound*)
-			   (slot-unbound (class-of instance) instance slot-name)
-			   value)))))
-     (cons   #'(lambda (instance)
-		 (let ((value (cdr index)))
-		   (if (eq value *slot-unbound*)
-		       (slot-unbound (class-of instance) instance slot-name)
-		       value)))))
+		 (lambda (instance)
+		   (let ((value (%instance-ref (fsc-instance-slots instance) index)))
+		     (if (eq value *slot-unbound*)
+			 (slot-unbound (class-of instance) instance slot-name)
+			 value)))
+		 (lambda (instance)
+		   (let ((value (%instance-ref (std-instance-slots instance) index)))
+		     (if (eq value *slot-unbound*)
+			 (slot-unbound (class-of instance) instance slot-name)
+			 value)))))
+     (cons   (lambda (instance)
+	       (let ((value (cdr index)))
+		 (if (eq value *slot-unbound*)
+		     (slot-unbound (class-of instance) instance slot-name)
+		     value)))))
    `(reader ,slot-name)))
 
 (defun make-optimized-std-writer-method-function (fsc-p slot-name index)
@@ -142,13 +142,13 @@
   (set-function-name
    (etypecase index
      (fixnum (if fsc-p
-		 #'(lambda (nv instance)
-		     (setf (%instance-ref (fsc-instance-slots instance) index) nv))
-		 #'(lambda (nv instance)
-		     (setf (%instance-ref (std-instance-slots instance) index) nv))))
-     (cons   #'(lambda (nv instance)
-		 (declare (ignore instance))
-		 (setf (cdr index) nv))))
+		 (lambda (nv instance)
+		   (setf (%instance-ref (fsc-instance-slots instance) index) nv))
+		 (lambda (nv instance)
+		   (setf (%instance-ref (std-instance-slots instance) index) nv))))
+     (cons   (lambda (nv instance)
+	       (declare (ignore instance))
+	       (setf (cdr index) nv))))
    `(writer ,slot-name)))
 
 (defun make-optimized-std-boundp-method-function (fsc-p slot-name index)
@@ -156,38 +156,38 @@
   (set-function-name
    (etypecase index
      (fixnum (if fsc-p
-		 #'(lambda (instance)
-		     (not (eq (%instance-ref (fsc-instance-slots instance)
-					     index)
-			      *slot-unbound*)))
-		 #'(lambda (instance)
-		     (not (eq (%instance-ref (std-instance-slots instance)
-					     index)
-			      *slot-unbound*)))))
-     (cons   #'(lambda (instance)
-		 (declare (ignore instance))
-		 (not (eq (cdr index) *slot-unbound*)))))
+		 (lambda (instance)
+		   (not (eq (%instance-ref (fsc-instance-slots instance)
+					   index)
+			    *slot-unbound*)))
+		 (lambda (instance)
+		   (not (eq (%instance-ref (std-instance-slots instance)
+					   index)
+			    *slot-unbound*)))))
+     (cons   (lambda (instance)
+	       (declare (ignore instance))
+	       (not (eq (cdr index) *slot-unbound*)))))
    `(boundp ,slot-name)))
 
 (defun make-optimized-structure-slot-value-using-class-method-function (function)
   (declare (type function function))
-  #'(lambda (class object slotd)
-      (let ((value (funcall function object)))
-	(if (eq value *slot-unbound*)
-	    (slot-unbound class object (slot-definition-name slotd))
-	    value))))	    
+  (lambda (class object slotd)
+    (let ((value (funcall function object)))
+      (if (eq value *slot-unbound*)
+	  (slot-unbound class object (slot-definition-name slotd))
+	  value))))	    
 
 (defun make-optimized-structure-setf-slot-value-using-class-method-function (function)
   (declare (type function function))
-  #'(lambda (nv class object slotd)
-      (declare (ignore class slotd))
-      (funcall function nv object)))
+  (lambda (nv class object slotd)
+    (declare (ignore class slotd))
+    (funcall function nv object)))
 
 (defun make-optimized-structure-slot-boundp-using-class-method-function (function)
   (declare (type function function))
-  #'(lambda (class object slotd)
-      (declare (ignore class slotd))
-      (not (eq (funcall function object) *slot-unbound*))))
+  (lambda (class object slotd)
+    (declare (ignore class slotd))
+    (not (eq (funcall function object) *slot-unbound*))))
 
 (defun get-optimized-std-slot-value-using-class-method-function (class slotd name)
   (if (structure-class-p class)
@@ -219,26 +219,26 @@
   (declare #.*optimize-speed*)
   (etypecase index
     (fixnum (if fsc-p
-		#'(lambda (class instance slotd)
-		    (declare (ignore slotd))
-		    (unless (fsc-instance-p instance) (error "not fsc"))
-		    (let ((value (%instance-ref (fsc-instance-slots instance) index)))
-		      (if (eq value *slot-unbound*)
-			  (slot-unbound class instance slot-name)
-			  value)))
-		#'(lambda (class instance slotd)
-		    (declare (ignore slotd))
-		    (unless (std-instance-p instance) (error "not std"))
-		    (let ((value (%instance-ref (std-instance-slots instance) index)))
-		      (if (eq value *slot-unbound*)
-			  (slot-unbound class instance slot-name)
-			  value)))))
-    (cons   #'(lambda (class instance slotd)
-		(declare (ignore slotd))
-		(let ((value (cdr index)))
-		  (if (eq value *slot-unbound*)
-		      (slot-unbound class instance slot-name)
-		      value))))))
+		(lambda (class instance slotd)
+		  (declare (ignore slotd))
+		  (unless (fsc-instance-p instance) (error "not fsc"))
+		  (let ((value (%instance-ref (fsc-instance-slots instance) index)))
+		    (if (eq value *slot-unbound*)
+			(slot-unbound class instance slot-name)
+			value)))
+		(lambda (class instance slotd)
+		  (declare (ignore slotd))
+		  (unless (std-instance-p instance) (error "not std"))
+		  (let ((value (%instance-ref (std-instance-slots instance) index)))
+		    (if (eq value *slot-unbound*)
+			(slot-unbound class instance slot-name)
+			value)))))
+    (cons   (lambda (class instance slotd)
+	      (declare (ignore slotd))
+	      (let ((value (cdr index)))
+		(if (eq value *slot-unbound*)
+		    (slot-unbound class instance slot-name)
+		    value))))))
 
 (defun make-optimized-std-setf-slot-value-using-class-method-function
     (fsc-p slot-name index)
@@ -246,15 +246,15 @@
   (declare (ignore slot-name))
   (etypecase index
     (fixnum (if fsc-p
-		#'(lambda (nv class instance slotd)
-		    (declare (ignore class slotd))
-		    (setf (%instance-ref (fsc-instance-slots instance) index) nv))
-		#'(lambda (nv class instance slotd)
-		    (declare (ignore class slotd))
-		    (setf (%instance-ref (std-instance-slots instance) index) nv))))
-    (cons   #'(lambda (nv class instance slotd)
-		(declare (ignore class instance slotd))
-		(setf (cdr index) nv)))))
+		(lambda (nv class instance slotd)
+		  (declare (ignore class slotd))
+		  (setf (%instance-ref (fsc-instance-slots instance) index) nv))
+		(lambda (nv class instance slotd)
+		  (declare (ignore class slotd))
+		  (setf (%instance-ref (std-instance-slots instance) index) nv))))
+    (cons   (lambda (nv class instance slotd)
+	      (declare (ignore class instance slotd))
+	      (setf (cdr index) nv)))))
 
 (defun make-optimized-std-slot-boundp-using-class-method-function
     (fsc-p slot-name index)
@@ -262,32 +262,32 @@
   (declare (ignore slot-name))
   (etypecase index
     (fixnum (if fsc-p
-		#'(lambda (class instance slotd)
-		    (declare (ignore class slotd))
-		    (not (eq (%instance-ref (fsc-instance-slots instance)
-					    index)
-			     *slot-unbound* )))
-		#'(lambda (class instance slotd)
-		    (declare (ignore class slotd))
-		    (not (eq (%instance-ref (std-instance-slots instance)
-					    index)
-			     *slot-unbound* )))))
-    (cons   #'(lambda (class instance slotd)
-		(declare (ignore class instance slotd))
-		(not (eq (cdr index) *slot-unbound*))))))
+		(lambda (class instance slotd)
+		  (declare (ignore class slotd))
+		  (not (eq (%instance-ref (fsc-instance-slots instance)
+					  index)
+			   *slot-unbound* )))
+		(lambda (class instance slotd)
+		  (declare (ignore class slotd))
+		  (not (eq (%instance-ref (std-instance-slots instance)
+					  index)
+			   *slot-unbound* )))))
+    (cons   (lambda (class instance slotd)
+	      (declare (ignore class instance slotd))
+	      (not (eq (cdr index) *slot-unbound*))))))
 
 (defun get-accessor-from-svuc-method-function (class slotd sdfun name)
   (macrolet ((emf-funcall (emf &rest args)
 	       `(invoke-effective-method-function ,emf nil ,@args)))
     (set-function-name
      (case name
-       (reader #'(lambda (instance) (emf-funcall sdfun class instance slotd)))
-       (writer #'(lambda (nv instance) (emf-funcall sdfun nv class instance slotd)))
-       (boundp #'(lambda (instance) (emf-funcall sdfun class instance slotd))))
+       (reader (lambda (instance) (emf-funcall sdfun class instance slotd)))
+       (writer (lambda (nv instance) (emf-funcall sdfun nv class instance slotd)))
+       (boundp (lambda (instance) (emf-funcall sdfun class instance slotd))))
      `(,name ,(class-name class) ,(slot-definition-name slotd)))))
 
 (defun make-internal-reader-method-function (class-name slot-name)
-  (list* ':method-spec `(internal-reader-method ,class-name ,slot-name)
+  (list* :method-spec `(internal-reader-method ,class-name ,slot-name)
 	 (make-method-function
 	  (lambda (instance)
 	    (let ((wrapper (get-instance-wrapper-or-nil instance)))
@@ -323,10 +323,10 @@
 			 (instance-read-internal 
 			  .pv. instance-slots 1
 			  (slot-value instance slot-name))))))))
-    (setf (getf (getf initargs ':plist) ':slot-name-lists)
+    (setf (getf (getf initargs :plist) :slot-name-lists)
 	  (list (list nil slot-name)))
-    (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol)
-    (list* ':method-spec `(reader-method ,class-name ,slot-name)
+    (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
+    (list* :method-spec `(reader-method ,class-name ,slot-name)
 	   initargs)))
 
 (defun make-std-writer-method-function (class-name slot-name)
@@ -340,10 +340,10 @@
 			 (instance-write-internal 
 			  .pv. instance-slots 1 nv
 			  (setf (slot-value instance slot-name) nv))))))))
-    (setf (getf (getf initargs ':plist) ':slot-name-lists)
+    (setf (getf (getf initargs :plist) :slot-name-lists)
 	  (list nil (list nil slot-name)))
-    (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol)
-    (list* ':method-spec `(writer-method ,class-name ,slot-name)
+    (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
+    (list* :method-spec `(writer-method ,class-name ,slot-name)
 	   initargs)))
 
 (defun make-std-boundp-method-function (class-name slot-name)
@@ -357,10 +357,10 @@
 			  (instance-boundp-internal 
 			   .pv. instance-slots 1
 			   (slot-boundp instance slot-name))))))))
-    (setf (getf (getf initargs ':plist) ':slot-name-lists)
+    (setf (getf (getf initargs :plist) :slot-name-lists)
 	  (list (list nil slot-name)))
-    (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol)
-    (list* ':method-spec `(boundp-method ,class-name ,slot-name)
+    (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
+    (list* :method-spec `(boundp-method ,class-name ,slot-name)
 	   initargs)))
 
 (defun initialize-internal-slot-gfs (slot-name &optional type)
diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp
index add1d32d2a14aecc525002c0e9e667bcb90ee248..e10a2a0f683b1d2d7b9eb9a4b4bea6623cc2d6e9 100644
--- a/pcl/std-class.lisp
+++ b/pcl/std-class.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.31 2002/08/19 16:43:15 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.32 2002/08/26 02:23:15 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -233,10 +233,11 @@
   (with-slots (direct-methods) specializer
     (or (cdr direct-methods)
 	(setf (cdr direct-methods)
-	      (gathering1 (collecting-once)
-		(dolist (m (car direct-methods))
-		  (gather1 (method-generic-function m))))))))
-
+	      (loop for method in (car direct-methods)
+		    for generic-function = (method-generic-function method)
+		    unless (member generic-function collected :test #'eq)
+ 		      collect generic-function into collected
+		    finally (return collected))))))
 
 
 ;;;
@@ -282,31 +283,33 @@
     (when entry
       (or (cdr entry)
 	  (setf (cdr entry)
-		(gathering1 (collecting-once)
-		  (dolist (m (car entry))
-		    (gather1 (method-generic-function m)))))))))
+		(loop for method in (car entry)
+		      for generic-function = (method-generic-function method)
+		      unless (member generic-function collected :test #'eq)
+		      collect generic-function into collected
+		      finally (return collected)))))))
 
 (defun map-specializers (function)
-  (map-all-classes #'(lambda (class)
-		       (funcall function (class-eq-specializer class))
-		       (funcall function class)))
-  (maphash #'(lambda (object methods)
-	       (declare (ignore methods))
-	       (intern-eql-specializer object))
+  (map-all-classes (lambda (class)
+		     (funcall function (class-eq-specializer class))
+		     (funcall function class)))
+  (maphash (lambda (object methods)
+	     (declare (ignore methods))
+	     (intern-eql-specializer object))
 	   *eql-specializer-methods*)
-  (maphash #'(lambda (object specl)
-	       (declare (ignore object))
-	       (funcall function specl))
+  (maphash (lambda (object specl)
+	     (declare (ignore object))
+	     (funcall function specl))
 	   *eql-specializer-table*)
   nil)
 
 (defun map-all-generic-functions (function)
   (let ((all-generic-functions (make-hash-table :test 'eq)))
-    (map-specializers #'(lambda (specl)
-			  (dolist (gf (specializer-direct-generic-functions specl))
-			    (unless (gethash gf all-generic-functions)
-			      (setf (gethash gf all-generic-functions) t)
-			      (funcall function gf))))))
+    (map-specializers (lambda (specl)
+			(dolist (gf (specializer-direct-generic-functions specl))
+			  (unless (gethash gf all-generic-functions)
+			    (setf (gethash gf all-generic-functions) t)
+			    (funcall function gf))))))
   nil)
 
 (defmethod shared-initialize :after ((specl class-eq-specializer) slot-names &key)
@@ -465,20 +468,21 @@
   (setq direct-slots
 	(if direct-slots-p
 	    (setf (slot-value class 'direct-slots)
-		  (mapcar #'(lambda (pl) (make-direct-slotd class pl)) direct-slots))
+		  (mapcar (lambda (pl) (make-direct-slotd class pl)) direct-slots))
 	    (slot-value class 'direct-slots)))
   (if direct-default-initargs-p
       (setf (plist-value class 'direct-default-initargs) direct-default-initargs)
       (setq direct-default-initargs (plist-value class 'direct-default-initargs)))
   (setf (plist-value class 'class-slot-cells)
-	(gathering1 (collecting)
-	  (dolist (dslotd direct-slots)
+	(let ((collected ()))
+	  (dolist (dslotd direct-slots (nreverse collected))
 	    (when (eq (slot-definition-allocation dslotd) class)
 	      (let ((initfunction (slot-definition-initfunction dslotd)))
-		(gather1 (cons (slot-definition-name dslotd)
-			       (if initfunction 
-				   (funcall initfunction)
-				   *slot-unbound*))))))))
+		(push (cons (slot-definition-name dslotd)
+			    (if initfunction 
+				(funcall initfunction)
+				*slot-unbound*))
+		      collected))))))
   (setq predicate-name (if predicate-name-p
 			   (setf (slot-value class 'predicate-name)
 				 (car predicate-name))
@@ -505,8 +509,8 @@
 					 &rest initargs
 					 &key)
   (map-dependents class
-		  #'(lambda (dependent)
-		      (apply #'update-dependent class dependent initargs))))
+		  (lambda (dependent)
+		    (apply #'update-dependent class dependent initargs))))
 
 (defmethod shared-initialize :after 
       ((class structure-class)
@@ -529,15 +533,15 @@
     (if direct-slots-p
 	(setf (slot-value class 'direct-slots)
 	      (setq direct-slots
-		    (mapcar #'(lambda (pl)
-				(when defstruct-p
-				  (let* ((slot-name (getf pl :name))
-					 (acc-name (format nil "~s structure class ~a" 
-							   name slot-name))
-					 (accessor (intern acc-name)))
-				    (setq pl (list* :defstruct-accessor-symbol accessor
-						    pl))))
-				(make-direct-slotd class pl))
+		    (mapcar (lambda (pl)
+			      (when defstruct-p
+				(let* ((slot-name (getf pl :name))
+				       (acc-name (format nil "~s structure class ~a" 
+							 name slot-name))
+				       (accessor (intern acc-name)))
+				  (setq pl (list* :defstruct-accessor-symbol accessor
+						  pl))))
+			      (make-direct-slotd class pl))
 			    direct-slots)))
 	(setq direct-slots (slot-value class 'direct-slots)))
     (when defstruct-p
@@ -550,45 +554,45 @@
 				      (:predicate nil)
 				      (:conc-name ,conc-name)
 				      (:constructor ,constructor ()))
-			   ,@(mapcar #'(lambda (slot)
-					 `(,(slot-definition-name slot)
-					   *slot-unbound*))
+			   ,@(mapcar (lambda (slot)
+				       `(,(slot-definition-name slot)
+					 *slot-unbound*))
 			             direct-slots)))
-	     (reader-names (mapcar #'(lambda (slotd)
-				       (intern (format nil "~A~A reader" conc-name 
-						       (slot-definition-name slotd))))
+	     (reader-names (mapcar (lambda (slotd)
+				     (intern (format nil "~A~A reader" conc-name 
+						     (slot-definition-name slotd))))
 				   direct-slots))
-	     (writer-names (mapcar #'(lambda (slotd)
-				       (intern (format nil "~A~A writer" conc-name 
-						       (slot-definition-name slotd))))
+	     (writer-names (mapcar (lambda (slotd)
+				     (intern (format nil "~A~A writer" conc-name 
+						     (slot-definition-name slotd))))
 				   direct-slots))
 	     (readers-init 
-	      (mapcar #'(lambda (slotd reader-name)
-			  (let ((accessor 
-				 (slot-definition-defstruct-accessor-symbol slotd)))
-			    `(defun ,reader-name (obj)
-			       (declare (type ,name obj))
-			       (,accessor obj))))
+	      (mapcar (lambda (slotd reader-name)
+			(let ((accessor 
+			       (slot-definition-defstruct-accessor-symbol slotd)))
+			  `(defun ,reader-name (obj)
+			     (declare (type ,name obj))
+			     (,accessor obj))))
 		      direct-slots reader-names))
 	     (writers-init 
-	      (mapcar #'(lambda (slotd writer-name)
-			  (let ((accessor 
-				 (slot-definition-defstruct-accessor-symbol slotd)))
-			    `(defun ,writer-name (nv obj)
-			       (declare (type ,name obj))
-			       (setf (,accessor obj) nv))))
+	      (mapcar (lambda (slotd writer-name)
+			(let ((accessor 
+			       (slot-definition-defstruct-accessor-symbol slotd)))
+			  `(defun ,writer-name (nv obj)
+			     (declare (type ,name obj))
+			     (setf (,accessor obj) nv))))
 		      direct-slots writer-names))
 	     (defstruct-form
 	       `(progn
 		  ,defstruct
 		  ,@readers-init ,@writers-init)))
 	(unless (structure-type-p name) (eval defstruct-form))
-	(mapc #'(lambda (dslotd reader-name writer-name)
-		  (let* ((reader (gdefinition reader-name))
-			 (writer (when (fboundp writer-name)
-				   (gdefinition writer-name))))
-		    (setf (slot-value dslotd 'internal-reader-function) reader)
-		    (setf (slot-value dslotd 'internal-writer-function) writer)))
+	(mapc (lambda (dslotd reader-name writer-name)
+		(let* ((reader (gdefinition reader-name))
+		       (writer (when (fboundp writer-name)
+				 (gdefinition writer-name))))
+		  (setf (slot-value dslotd 'internal-reader-function) reader)
+		  (setf (slot-value dslotd 'internal-writer-function) writer)))
 	      direct-slots reader-names writer-names)
 	(setf (slot-value class 'defstruct-form) defstruct-form)
 	(setf (slot-value class 'defstruct-constructor) constructor))))
@@ -718,10 +722,8 @@
 	    (cond ((null owrapper)
 		   (make-wrapper nslots class))
 		  ((and (equal nlayout olayout)
-			(not
-			 (iterate ((o (list-elements owrapper-class-slots))
-				   (n (list-elements nwrapper-class-slots)))
-				  (unless (eq (car o) (car n)) (return t)))))
+			(every (lambda (o n) (eq (car o) (car n)))
+			       owrapper-class-slots nwrapper-class-slots))
 		   owrapper)
 		  (t
 		   ;;
@@ -745,18 +747,15 @@
 	(update-pv-table-cache-info class)))))
 
 (defun compute-class-slots (eslotds)
-  (gathering1 (collecting)
-    (dolist (eslotd eslotds)
-      (gather1
-	(assoc (slot-definition-name eslotd)
-	       (class-slot-cells (slot-definition-allocation eslotd)))))))
+  (loop for eslotd in eslotds
+	for name = (slot-definition-name eslotd)
+	and allocation = (slot-definition-allocation eslotd)
+	collect (assoc name (class-slot-cells allocation))))
 
 (defun compute-layout (cpl instance-eslotds)
-  (let* ((names
-	   (gathering1 (collecting)
-	     (dolist (eslotd instance-eslotds)
-	       (when (eq (slot-definition-allocation eslotd) :instance)
-		 (gather1 (slot-definition-name eslotd))))))
+  (let* ((names (loop for eslotd in instance-eslotds
+		      when (eq (slot-definition-allocation eslotd) :instance)
+		      collect (slot-definition-name eslotd)))
 	 (order ()))
     (labels ((rwalk (tail)
 	       (when tail
@@ -782,9 +781,9 @@
 		   (setf (gethash gf gf-table) t))
 		 (mapc #'collect-gfs (class-direct-superclasses class))))
 	(collect-gfs class)
-	(maphash #'(lambda (gf ignore)
-		     (declare (ignore ignore))
-		     (update-gf-dfun class gf))
+	(maphash (lambda (gf ignore)
+		   (declare (ignore ignore))
+		   (update-gf-dfun class gf))
 		 gf-table)))))
 
 (defun update-inits (class inits)
@@ -842,9 +841,9 @@
 	    (if entry
 		(push d (cdr entry))
 		(push (list name d) name-dslotds-alist))))))
-    (mapcar #'(lambda (direct)
-		(compute-effective-slot-definition class
-						   (nreverse (cdr direct))))
+    (mapcar (lambda (direct)
+	      (compute-effective-slot-definition class
+						 (nreverse (cdr direct))))
 	    name-dslotds-alist)))
 
 (defmethod compute-slots :around ((class std-class))
@@ -868,11 +867,10 @@
     eslotds))
 
 (defmethod compute-slots ((class structure-class))
-  (mapcan #'(lambda (superclass)
-	      (mapcar #'(lambda (dslotd)
-			  (compute-effective-slot-definition class
-							     (list dslotd)))
-		      (class-direct-slots superclass)))
+  (mapcan (lambda (superclass)
+	    (mapcar (lambda (dslotd)
+		      (compute-effective-slot-definition class (list dslotd)))
+		    (class-direct-slots superclass)))
 	  (reverse (slot-value class 'class-precedence-list))))
 
 (defmethod compute-slots :around ((class structure-class))
@@ -920,7 +918,7 @@
 		allocp t))
 	(setq initargs (append (slot-definition-initargs slotd) initargs))
 	(let ((slotd-type (slot-definition-type slotd)))
-	  (setq type (cond ((eq type 't) slotd-type)
+	  (setq type (cond ((eq type t) slotd-type)
 			   ((*subtypep type slotd-type) type)
 			   (t `(and ,type ,slotd-type)))))))
     (list :name name
@@ -1069,7 +1067,7 @@
     ;; sure we never change an OBSOLETE into a FLUSH since OBSOLETE
     ;; means do what FLUSH does and then some.
     ;; 
-    (when (eq state 't)
+    (when (eq state t)
       (let ((nwrapper (make-wrapper (wrapper-no-of-instance-slots owrapper)
 				    class)))
 	(setf (wrapper-instance-slots-layout nwrapper)
@@ -1079,7 +1077,7 @@
 	(without-interrupts
 	  (update-lisp-class-layout class nwrapper)
 	  (setf (slot-value class 'wrapper) nwrapper)
-	  (invalidate-wrapper owrapper ':flush nwrapper))))))
+	  (invalidate-wrapper owrapper :flush nwrapper))))))
 
 (defun flush-cache-trap (owrapper nwrapper instance)
   (declare (ignore owrapper))
@@ -1103,7 +1101,7 @@
       (without-interrupts
 	(update-lisp-class-layout class nwrapper)
 	(setf (slot-value class 'wrapper) nwrapper)
-	(invalidate-wrapper owrapper ':obsolete nwrapper)
+	(invalidate-wrapper owrapper :obsolete nwrapper)
 	class)))
 
 (defmethod make-instances-obsolete ((class symbol))
@@ -1179,28 +1177,28 @@
 	;;  --    --> shared        --
 	;;
 	;; Go through all the old local slots.
-	;; 
-	(iterate ((name (list-elements olayout))
-		  (opos (interval :from 0)))
-	  (let ((npos (posq name nlayout)))
-	    (if npos
-		(setf (instance-ref nslots npos) (instance-ref oslots opos))
-		(progn
-		  (push name discarded)
-		  (unless (eq (instance-ref oslots opos) *slot-unbound*)
-		    (setf (getf plist name) (instance-ref oslots opos)))))))
+	;;
+	(loop for name in olayout and opos from 0
+	      as npos = (posq name nlayout)
+	      if npos do
+	        (setf (instance-ref nslots npos)
+		      (instance-ref oslots opos))
+	      else do
+		(push name discarded)
+		(unless (eq (instance-ref oslots opos) *slot-unbound*)
+		  (setf (getf plist name)
+			(instance-ref oslots opos))))
 	;;
 	;; Go through all the old shared slots.
 	;;
-	(iterate ((oclass-slot-and-val (list-elements oclass-slots)))
-	  (let ((name (car oclass-slot-and-val))
-		(val (cdr oclass-slot-and-val)))
-	    (let ((npos (posq name nlayout)))
-	      (if npos
-		  (setf (instance-ref nslots npos) (cdr oclass-slot-and-val))
-		  (progn (push name discarded)
-			 (unless (eq val *slot-unbound*)
-			   (setf (getf plist name) val)))))))
+	(loop for (name . val) in oclass-slots
+	      for npos = (posq name nlayout)
+	      if npos do
+	        (setf (instance-ref nslots npos) val)
+	      else do
+	        (push name discarded)
+		(unless (eq val *slot-unbound*)
+		  (setf (getf plist name) val)))
 	;;
 	;; Go through all the new local slots to compute the added slots.
 	;; 
@@ -1245,22 +1243,20 @@
     ;; "The values of local slots specified by both the class Cto and
     ;; Cfrom are retained.  If such a local slot was unbound, it remains
     ;; unbound."
-    ;;     
-    (iterate ((new-slot (list-elements new-layout))
-	      (new-position (interval :from 0)))
-      (let ((old-position (posq new-slot old-layout)))
-	(when old-position
-	  (setf (instance-ref new-slots new-position)
-		(instance-ref old-slots old-position)))))
-
+    ;;
+    (loop for new-slot in new-layout and new-position from 0
+	  for old-position = (posq new-slot old-layout)
+	  when old-position do
+	    (setf (instance-ref new-slots new-position)
+		  (instance-ref old-slots old-position)))
     ;;
     ;; "The values of slots specified as shared in the class Cfrom and
     ;; as local in the class Cto are retained."
     ;;
-    (iterate ((slot-and-val (list-elements old-class-slots)))
-      (let ((position (posq (car slot-and-val) new-layout)))
-	(when position
-	  (setf (instance-ref new-slots position) (cdr slot-and-val)))))
+    (loop for (name . val) in old-class-slots
+	  for new-position = (posq name new-layout)
+	  when new-position do
+	    (setf (instance-ref new-slots new-position) val))
 
     ;; Make the copy point to the old instance's storage, and make the
     ;; old instance point to the new storage.
@@ -1331,7 +1327,7 @@
 
 (defmethod validate-superclass ((c slot-class)
 				(f forward-referenced-class))
-  't)
+  t)
 
 
 ;;;
diff --git a/pcl/structure-class.lisp b/pcl/structure-class.lisp
index 613e98bbb3d711d64e5dbdc7e58f2dfb9db26a3d..c33722a5a9547d241d324c7fd89bb99cb5b46ddd 100644
--- a/pcl/structure-class.lisp
+++ b/pcl/structure-class.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/structure-class.lisp,v 1.3 1999/05/30 23:14:09 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/structure-class.lisp,v 1.4 2002/08/26 02:23:15 pmai Exp $")
 ;;;
 
 (in-package 'pcl)
@@ -123,9 +123,9 @@
     (setq direct-slots
           (if direct-slots-p
 	      (setf (slot-value class 'direct-slots)
-		    (mapcar #'(lambda (pl)
-                                (apply #'make-direct-slotd class
-                                        :conc-name conc-name pl))
+		    (mapcar (lambda (pl)
+			      (apply #'make-direct-slotd class
+				     :conc-name conc-name pl))
 			    direct-slots))
 	      (slot-value class 'direct-slots)))
     (when from-defclass-p
@@ -192,37 +192,37 @@
                (remove-if #'slot-definition-internal-reader-function
                           direct-slots)))
 	 (reader-names
-           (mapcar #'(lambda (slotd)
-		       (intern (format nil "~A~A reader" conc-name
-				       (slot-definition-name slotd))
-                                package))
+           (mapcar (lambda (slotd)
+		     (intern (format nil "~A~A reader" conc-name
+				     (slot-definition-name slotd))
+			     package))
 		   direct-slots-needing-internals))
 	 (writer-names
-           (mapcar #'(lambda (slotd)
-		       (intern (format nil "~A~A writer" conc-name 
-				       (slot-definition-name slotd))
-                               package))
+           (mapcar (lambda (slotd)
+		     (intern (format nil "~A~A writer" conc-name 
+				     (slot-definition-name slotd))
+			     package))
 		   direct-slots-needing-internals))
          (defstruct-accessor-names
            (mapcar #'slot-definition-defstruct-accessor-symbol
                    direct-slots-needing-internals))
 	 (readers-init
-	   (mapcar #'(lambda (defstruct-accessor reader-name)
-		       `(progn
-                          (force-compile ',defstruct-accessor)
-                          (defun ,reader-name (obj)
-		            (declare (type ,name obj) #.*optimize-speed*)
-			    (,defstruct-accessor obj))
-                          (force-compile ',reader-name)))
+	   (mapcar (lambda (defstruct-accessor reader-name)
+		     `(progn
+		       (force-compile ',defstruct-accessor)
+		       (defun ,reader-name (obj)
+			 (declare (type ,name obj) #.*optimize-speed*)
+			 (,defstruct-accessor obj))
+		       (force-compile ',reader-name)))
 		   defstruct-accessor-names reader-names))
 	 (writers-init
-	   (mapcar #'(lambda (defstruct-accessor writer-name)
-		       `(progn
-                          (force-compile ',defstruct-accessor)
-                          (defun ,writer-name (nv obj)
-			    (declare (type ,name obj) #.*optimize-speed*)
-			    (setf (,defstruct-accessor obj) nv))
-                          (force-compile ',writer-name)))
+	   (mapcar (lambda (defstruct-accessor writer-name)
+		     `(progn
+		       (force-compile ',defstruct-accessor)
+		       (defun ,writer-name (nv obj)
+			 (declare (type ,name obj) #.*optimize-speed*)
+			 (setf (,defstruct-accessor obj) nv))
+		       (force-compile ',writer-name)))
 		   defstruct-accessor-names writer-names))
 	 (defstruct-extras-form
 	   `(progn
@@ -234,19 +234,19 @@
               ,@writers-init)))
     (declare (type package package))
     (eval defstruct-extras-form)
-    (mapc #'(lambda (dslotd reader-name writer-name)
-	      (setf (slot-value dslotd 'internal-reader-function)
-                    (gdefinition reader-name))
-	      (setf (slot-value dslotd 'internal-writer-function)
-                    (gdefinition writer-name)))
+    (mapc (lambda (dslotd reader-name writer-name)
+	    (setf (slot-value dslotd 'internal-reader-function)
+		  (gdefinition reader-name))
+	    (setf (slot-value dslotd 'internal-writer-function)
+		  (gdefinition writer-name)))
 	  direct-slots-needing-internals reader-names writer-names)))
 
 (defmethod reinitialize-instance :after ((class structure-class)
 					 &rest initargs
 					 &key)
   (map-dependents class
-		  #'(lambda (dependent)
-		      (apply #'update-dependent class dependent initargs))))
+		  (lambda (dependent)
+		    (apply #'update-dependent class dependent initargs))))
 
 (defmethod direct-slot-definition-class ((class structure-class) initargs)
   (declare (ignore initargs))
@@ -261,11 +261,11 @@
 
 
 (defmethod compute-slots ((class structure-class))
-  (mapcan #'(lambda (superclass)
-	      (mapcar #'(lambda (dslotd)
-			  (compute-effective-slot-definition
-			     class (slot-definition-name dslotd) (list dslotd)))
-		      (class-direct-slots superclass)))
+  (mapcan (lambda (superclass)
+	    (mapcar (lambda (dslotd)
+		      (compute-effective-slot-definition
+		       class (slot-definition-name dslotd) (list dslotd)))
+		    (class-direct-slots superclass)))
 	  (reverse (slot-value class 'class-precedence-list))))
 
 (defmethod compute-slots :around ((class structure-class))
@@ -320,18 +320,18 @@
 
 (defun make-structure-instance-reader-method-function (slot-name)
   (declare #.*optimize-speed*)
-  #'(lambda (instance)
-      (structure-instance-slot-value instance slot-name)))
+  (lambda (instance)
+    (structure-instance-slot-value instance slot-name)))
 
 (defun make-structure-instance-writer-method-function (slot-name)
   (declare #.*optimize-speed*)
-  #'(lambda (nv instance)
-      (setf (structure-instance-slot-value instance slot-name) nv)))
+  (lambda (nv instance)
+    (setf (structure-instance-slot-value instance slot-name) nv)))
 
 (defun make-structure-instance-boundp-method-function (slot-name)
   (declare #.*optimize-speed*)
-  #'(lambda (instance)
-      (structure-instance-slot-boundp instance slot-name)))
+  (lambda (instance)
+    (structure-instance-slot-boundp instance slot-name)))
 
 (defmethod wrapper-fetcher ((class structure-class))
   'wrapper-for-structure)
diff --git a/pcl/user-instances.lisp b/pcl/user-instances.lisp
index e961f38df67c433d385cfec59a6759c00a399f32..ef254dc2b81b83e5f71c8d55d15a27dfd151be2d 100644
--- a/pcl/user-instances.lisp
+++ b/pcl/user-instances.lisp
@@ -20,7 +20,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/user-instances.lisp,v 1.3 1999/05/30 23:14:09 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/user-instances.lisp,v 1.4 2002/08/26 02:23:16 pmai Exp $")
 ;;;
 
 (in-package 'pcl)
@@ -284,39 +284,39 @@
 
 (defun make-user-vector-instance-reader-method-function (slot-name)
   (declare #.*optimize-speed*)
-  #'(lambda (instance)
-      (user-instance-slot-value instance slot-name)))
+  (lambda (instance)
+    (user-instance-slot-value instance slot-name)))
 
 (defun make-user-vector-instance-writer-method-function (slot-name)
   (declare #.*optimize-speed*)
-  #'(lambda (nv instance)
-      (setf (user-instance-slot-value instance slot-name) nv)))
+  (lambda (nv instance)
+    (setf (user-instance-slot-value instance slot-name) nv)))
 
 (defun make-user-vector-instance-boundp-method-function (slot-name)
   (declare #.*optimize-speed*)
-  #'(lambda (instance)
-      (user-instance-slot-boundp instance slot-name)))
+  (lambda (instance)
+    (user-instance-slot-boundp instance slot-name)))
 
 
 (defun make-optimized-user-reader-method-function (slot-name index)
   (declare #.*optimize-speed*)
   (progn slot-name)
-  #'(lambda (instance)
-      (let ((value (%svref (user-vector-instance-slots instance) index)))
-        (if (eq value *slot-unbound*)
-            (slot-unbound (class-of instance) instance slot-name)
-            value))))
+  (lambda (instance)
+    (let ((value (%svref (user-vector-instance-slots instance) index)))
+      (if (eq value *slot-unbound*)
+	  (slot-unbound (class-of instance) instance slot-name)
+	  value))))
 
 (defun make-optimized-user-writer-method-function (index)
   (declare #.*optimize-speed*)
-  #'(lambda (nv instance)
-      (setf (%svref (user-vector-instance-slots instance) index) nv)))
+  (lambda (nv instance)
+    (setf (%svref (user-vector-instance-slots instance) index) nv)))
 
 (defun make-optimized-user-boundp-method-function (index)
   (declare #.*optimize-speed*)
-  #'(lambda (instance)
-      (not (eq (%svref (user-vector-instance-slots instance) index)
-               *slot-unbound*))))
+  (lambda (instance)
+    (not (eq (%svref (user-vector-instance-slots instance) index)
+	     *slot-unbound*))))
 
 
 
@@ -443,11 +443,11 @@
             (declare (type index first-dimension))
             (walk-dimensions
               (mapcar #'min (cdr new-dimensions) (cdr old-dimensions))
-              #'(lambda (post-indices)
-                 (copy-array-contents old-array new-array
-                                      :key key
-                                      :length first-dimension
-                                      :post-indices post-indices)))))
+              (lambda (post-indices)
+		(copy-array-contents old-array new-array
+				     :key key
+				     :length first-dimension
+				     :post-indices post-indices)))))
        new-array))))
 
 (defun copy-array-contents
@@ -620,11 +620,11 @@
                    (copy-any-array
                      item
                      :key
-                     #'(lambda (item)
-                         (if (user-vector-instance-p item)
-                             (let ((dummy (dummy-print-instance-of item)))
-                               (push dummy dummy-print-instances-used)
-                               dummy)
+                     (lambda (item)
+		       (if (user-vector-instance-p item)
+			   (let ((dummy (dummy-print-instance-of item)))
+			     (push dummy dummy-print-instances-used)
+			     dummy)
                            item))
                      :dimensions
                        (mapcar #'1+ (array-dimensions item)))
diff --git a/pcl/vector.lisp b/pcl/vector.lisp
index 7f3bd6a95638cf4659d6ab8c30821735d318d394..2a0e6efad0aa92b31090b8f3045392976ed71cc7 100644
--- a/pcl/vector.lisp
+++ b/pcl/vector.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.16 2002/08/19 16:52:09 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.17 2002/08/26 02:23:16 pmai Exp $")
 ;;;
 ;;; Permutation vectors.
 ;;;
@@ -169,21 +169,22 @@
 		location)))))))
 
 (defun compute-pv (slot-name-lists wrappers)
-  (unless (listp wrappers) (setq wrappers (list wrappers)))
   (let* ((not-simple-p-cell (list nil))
 	 (elements
-	  (gathering1 (collecting)
-	    (iterate ((slot-names (list-elements slot-name-lists)))
-	      (when slot-names
-		(let* ((wrapper     (pop wrappers))
-		       (std-p (typep wrapper 'wrapper))
-		       (class       (wrapper-class* wrapper))
-		       (class-slots (and std-p (wrapper-class-slots wrapper))))
-		  (dolist (slot-name (cdr slot-names))
-		    (gather1
-		     (when std-p
-		       (compute-pv-slot slot-name wrapper class 
-					class-slots not-simple-p-cell))))))))))
+	  (loop with wrappers = (if (listp wrappers) wrappers (list wrappers))
+		for slot-names in slot-name-lists
+		when slot-names
+		  nconc (loop with wrapper = (pop wrappers)
+			      with stdp = (typep wrapper 'wrapper)
+			      and class = (wrapper-class* wrapper)
+			      with class-slots
+			        = (and stdp (wrapper-class-slots wrapper))
+			      for slot-name in (cdr slot-names)
+			      collect
+			        (when stdp
+				  (compute-pv-slot slot-name wrapper class
+						   class-slots
+						   not-simple-p-cell))))))
     (if (car not-simple-p-cell)
 	(make-permutation-vector (cons t elements))
 	(or (gethash elements *pvs*)
@@ -194,7 +195,7 @@
   (declare (ignore call-list wrappers))
   #||
   (map 'vector
-       #'(lambda (call)
+       (lambda (call)
 	   (compute-emf-from-wrappers call wrappers))
        call-list)
   ||#  
@@ -206,19 +207,19 @@
     (destructuring-bind (gf-name nreq restp arg-info) call
       (if (eq gf-name 'make-instance)
 	  (error "should not get here") ; there is another mechanism for this.
-	  #'(lambda (&rest args)
-	      (if (not (eq *boot-state* 'complete))
-		  (apply (gdefinition gf-name) args)
-		  (let* ((gf (gdefinition gf-name))
-			 (arg-info (arg-info-reader gf))
-			 (classes '?)
-			 (types '?)
-			 (emf (cache-miss-values-internal gf arg-info 
-							  wrappers classes types 
-							  'caching)))
-		    (update-all-pv-tables call wrappers emf)
-		    #+copy-&rest-arg (setq args (copy-list args))
-		    (invoke-emf emf args))))))))
+	  (lambda (&rest args)
+	    (if (not (eq *boot-state* 'complete))
+		(apply (gdefinition gf-name) args)
+		(let* ((gf (gdefinition gf-name))
+		       (arg-info (arg-info-reader gf))
+		       (classes '?)
+		       (types '?)
+		       (emf (cache-miss-values-internal gf arg-info 
+							wrappers classes types 
+							'caching)))
+		  (update-all-pv-tables call wrappers emf)
+		  #+copy-&rest-arg (setq args (copy-list args))
+		  (invoke-emf emf args))))))))
 ||#
 
 (defun make-permutation-vector (indexes)
@@ -282,26 +283,27 @@
 	 (std-p (typep cwrapper 'wrapper))
 	 (class-slots (and std-p (wrapper-class-slots cwrapper)))
 	 (class-slot-p-cell (list nil))
-	 (new-values (mapcar #'(lambda (slot-name)
-				 (cons slot-name
-				       (when std-p
-					 (compute-pv-slot 
-					  slot-name cwrapper class 
-					  class-slots class-slot-p-cell))))
+	 (new-values (mapcar (lambda (slot-name)
+			       (cons slot-name
+				     (when std-p
+				       (compute-pv-slot 
+					slot-name cwrapper class 
+					class-slots class-slot-p-cell))))
 			     slot-names))
 	 (pv-tables nil))
     (dolist (slot-name slot-names)
       (map-pv-table-references-of
        slot-name
-       #'(lambda (pv-table pv-offset-list)
-	   (declare (ignore pv-offset-list))
-	   (pushnew pv-table pv-tables))))
+       (lambda (pv-table pv-offset-list)
+	 (declare (ignore pv-offset-list))
+	 (pushnew pv-table pv-tables))))
     (dolist (pv-table pv-tables)
       (let* ((cache (pv-table-cache pv-table))
 	     (slot-name-lists (pv-table-slot-name-lists pv-table))
 	     (pv-size (pv-table-pv-size pv-table))
 	     (pv-map (make-array pv-size :initial-element nil)))
-	(let ((map-index 1)(param-index 0))
+	(let ((map-index 1)
+	      (param-index 0))
 	  (dolist (slot-name-list slot-name-lists)
 	    (dolist (slot-name (cdr slot-name-list))
 	      (let ((a (assoc slot-name new-values)))
@@ -310,10 +312,10 @@
 	      (incf map-index))
 	    (incf param-index)))
 	(when cache
-	  (map-cache #'(lambda (wrappers pv-cell)
-			 (setf (car pv-cell)
-			       (update-slots-in-pv wrappers (car pv-cell)
-						   cwrapper pv-size pv-map)))
+	  (map-cache (lambda (wrappers pv-cell)
+		       (setf (car pv-cell)
+			     (update-slots-in-pv wrappers (car pv-cell)
+						 cwrapper pv-size pv-map)))
 		     cache))))))
 
 (defun update-slots-in-pv (wrappers pv cwrapper pv-size pv-map)
@@ -598,8 +600,8 @@
 	   (non-required-args (nthcdr nreq args))
 	   (required-args (ldiff args non-required-args))
 	   (call-spec (list (car gf-call-form) nreq restp
-			    (mapcar #'(lambda (form)
-					(optimize-gf-call-internal form slots env))
+			    (mapcar (lambda (form)
+				      (optimize-gf-call-internal form slots env))
 				    (if all-args-p
 					args
 					required-args))))
@@ -656,16 +658,16 @@
 (defmacro instance-read-internal (pv slots pv-offset default &optional type)
   (unless (member type '(nil :instance :class :default))
     (error "Illegal type argument to ~S: ~S" 'instance-read-internal type))
-  (if (eq type ':default)
+  (if (eq type :default)
       default
       (let* ((index (gensym))
 	     (value index))
 	`(locally (declare #.*optimize-speed*)
 	  (let ((,index (pvref ,pv ,pv-offset)))
 	    (setq ,value (typecase ,index
-			   ,@(when (or (null type) (eq type ':instance))
+			   ,@(when (or (null type) (eq type :instance))
 			       `((fixnum (%instance-ref ,slots ,index))))
-			   ,@(when (or (null type) (eq type ':class))
+			   ,@(when (or (null type) (eq type :class))
 			       `((cons (cdr ,index))))
 			   (t ',*slot-unbound*)))
 	    (if (eq ,value ',*slot-unbound*)
@@ -678,7 +680,7 @@
       `(instance-read-internal .pv. ,(slot-vector-symbol position)
 	,pv-offset (accessor-slot-value ,parameter ,slot-name)
 	,(if (generate-fast-class-slot-access-p class slot-name)
-	     ':class ':instance))))
+	     :class :instance))))
 
 (defmacro instance-reader (pv-offset parameter position gf-name class)
   (declare (ignore class))
@@ -691,15 +693,15 @@
 				      &optional type)
   (unless (member type '(nil :instance :class :default))
     (error "Illegal type argument to ~S: ~S" 'instance-write-internal type))
-  (if (eq type ':default)
+  (if (eq type :default)
       default
       (let* ((index (gensym)))
 	`(locally (declare #.*optimize-speed*)
 	  (let ((,index (pvref ,pv ,pv-offset)))
 	    (typecase ,index
-	      ,@(when (or (null type) (eq type ':instance))
+	      ,@(when (or (null type) (eq type :instance))
 		  `((fixnum (setf (%instance-ref ,slots ,index) ,new-value))))
-	      ,@(when (or (null type) (eq type ':class))
+	      ,@(when (or (null type) (eq type :class))
 		  `((cons (setf (cdr ,index) ,new-value))))
 	      (t ,default)))))))
 
@@ -710,7 +712,7 @@
 	,pv-offset ,new-value
 	(accessor-set-slot-value ,parameter ,slot-name ,new-value)
 	,(if (generate-fast-class-slot-access-p class slot-name)
-	     ':class ':instance))))
+	     :class :instance))))
 
 (defmacro instance-writer (pv-offset parameter position gf-name class new-value)
   (declare (ignore class))
@@ -723,15 +725,15 @@
 				       &optional type)
   (unless (member type '(nil :instance :class :default))
     (error "Illegal type argument to ~S: ~S" 'instance-boundp-internal type))
-  (if (eq type ':default)
+  (if (eq type :default)
       default
       (let* ((index (gensym)))
 	`(locally (declare #.*optimize-speed*)
 	  (let ((,index (pvref ,pv ,pv-offset)))
 	    (typecase ,index
-	      ,@(when (or (null type) (eq type ':instance))
+	      ,@(when (or (null type) (eq type :instance))
 		  `((fixnum (not (eq (%instance-ref ,slots ,index) ',*slot-unbound*)))))
-	      ,@(when (or (null type) (eq type ':class))
+	      ,@(when (or (null type) (eq type :class))
 		  `((cons (not (eq (cdr ,index) ',*slot-unbound*)))))
 	      (t ,default)))))))
 
@@ -741,7 +743,7 @@
       `(instance-boundp-internal .pv. ,(slot-vector-symbol position)
 	,pv-offset (accessor-slot-boundp ,parameter ,slot-name)
 	,(if (generate-fast-class-slot-access-p class slot-name)
-	     ':class ':instance))))
+	     :class :instance))))
 
 ;;;
 ;;; This magic function has quite a job to do indeed.
@@ -763,8 +765,8 @@
   (multiple-value-bind (slots calls)
       (mutate-slots-and-calls slots calls)
     (let* ((slot-name-lists
-	    (mapcar #'(lambda (parameter-entry)
-			(cons nil (mapcar #'car (cdr parameter-entry))))
+	    (mapcar (lambda (parameter-entry)
+		      (cons nil (mapcar #'car (cdr parameter-entry))))
 		    slots))
 	   (call-list
 	    (mapcar #'car calls)))
@@ -772,22 +774,22 @@
 	(dolist (arg (cdr call))
 	  (when (integerp arg)
 	    (setf (car (nth arg slot-name-lists)) t))))
-      (setq slot-name-lists (mapcar #'(lambda (r+snl)
-					(when (or (car r+snl) (cdr r+snl))
-					  r+snl))
+      (setq slot-name-lists (mapcar (lambda (r+snl)
+				      (when (or (car r+snl) (cdr r+snl))
+					r+snl))
 				    slot-name-lists))
       (let ((cvt (apply #'vector
 			(let ((i -1))
-			  (mapcar #'(lambda (r+snl)
-				      (when r+snl (incf i)))
+			  (mapcar (lambda (r+snl)
+				    (when r+snl (incf i)))
 				  slot-name-lists)))))
-	(setq call-list (mapcar #'(lambda (call)
-				    (cons (car call) 
-					  (mapcar #'(lambda (arg)
-						      (if (integerp arg)
-							  (svref cvt arg)
-							  arg))
-						  (cdr call))))
+	(setq call-list (mapcar (lambda (call)
+				  (cons (car call) 
+					(mapcar (lambda (arg)
+						  (if (integerp arg)
+						      (svref cvt arg)
+						      arg))
+						(cdr call))))
 				call-list)))
       (values slot-name-lists call-list))))
 
@@ -830,11 +832,11 @@
 			(symbol-or-cons-lessp (car a) (car b))))))))
 
 (defun sort-slots (slots)
-  (mapcar #'(lambda (parameter-entry)
-	      (cons (car parameter-entry)
-		    (sort (cdr parameter-entry)	;slot entries
-			  #'symbol-or-cons-lessp
-			  :key #'car)))
+  (mapcar (lambda (parameter-entry)
+	    (cons (car parameter-entry)
+		  (sort (cdr parameter-entry) ;slot entries
+			#'symbol-or-cons-lessp
+			:key #'car)))
 	  slots))
 
 (defun sort-calls (calls)
@@ -848,21 +850,21 @@
 
 (defmacro pv-binding ((required-parameters slot-name-lists pv-table-symbol)
 		      &body body)
-  (with-gathering ((slot-vars (collecting))
-		   (pv-parameters (collecting)))
-    (iterate ((slots (list-elements slot-name-lists))
-	      (required-parameter (list-elements required-parameters))
-	      (i (interval :from 0)))
-      (when slots
-	(gather required-parameter pv-parameters)
-	(gather (slot-vector-symbol i) slot-vars)))
-    `(pv-binding1 (.pv. .calls. ,pv-table-symbol ,pv-parameters ,slot-vars)
-       ,@body)))
+  (loop for slot-names in slot-name-lists
+	and required-parameter in required-parameters
+	and i of-type fixnum from 0
+	when slot-names
+	  collect required-parameter into pv-parameters
+	  and collect (slot-vector-symbol i) into slot-vars
+	finally
+	  (return `(pv-binding1 (.pv. .calls. ,pv-table-symbol
+				      ,pv-parameters ,slot-vars)
+		     ,@body))))
 
 (defmacro pv-binding1 ((pv calls pv-table-symbol pv-parameters slot-vars) 
 		       &body body)
   `(pv-env (,pv ,calls ,pv-table-symbol ,pv-parameters)
-     (let (,@(mapcar #'(lambda (slot-var p) `(,slot-var (get-slots-or-nil ,p)))
+     (let (,@(mapcar (lambda (slot-var p) `(,slot-var (get-slots-or-nil ,p)))
 	       slot-vars pv-parameters))
 	,@body)))
 
@@ -958,14 +960,19 @@
 	`(list* :function #',method-lambda
 	        ',initargs)
 	(let* ((lambda-list (car lmf-params))
-	       (nreq 0)(restp nil)(args nil))
+	       (nreq 0)
+	       (restp nil)
+	       (args nil))
 	  (dolist (arg lambda-list)
 	    (when (member arg '(&optional &rest &key))
-	      (setq restp t)(return nil))
-	    (when (eq arg '&aux) (return nil))
-	    (incf nreq)(push arg args))
+	      (setq restp t)
+	      (return nil))
+	    (when (eq arg '&aux)
+	      (return nil))
+	    (incf nreq)
+	    (push arg args))
 	  (setq args (nreverse args))
-	  (setf (getf (getf initargs ':plist) ':arg-info) (cons nreq restp))
+	  (setf (getf (getf initargs :plist) :arg-info) (cons nreq restp))
 	  (make-method-initargs-form-internal1
 	   initargs (cddr lmf) args lmf-params restp)))))
 
@@ -977,23 +984,23 @@
     (let* ((rest-arg (when restp '.rest-arg.))
 	   (args+rest-arg (if restp (append req-args (list rest-arg)) req-args)))
       `(list* :fast-function
-	#'(lambda (.pv-cell. .next-method-call. ,@args+rest-arg)
-	    ,@outer-decls
-	    .pv-cell. .next-method-call.
-	    (macrolet ((pv-env ((pv calls pv-table-symbol pv-parameters)
-				&rest forms)
-			 (declare (ignore pv-table-symbol pv-parameters))
-			 `(let ((,pv (car .pv-cell.))
-				(,calls (cdr .pv-cell.)))
-			   (declare ,(make-pv-type-declaration pv)
-			    ,(make-calls-type-declaration calls))
-			   ,pv ,calls
-			   ,@forms)))
-	      (fast-lexical-method-functions 
-	       (,(car lmf-params) .next-method-call. ,req-args ,rest-arg
-		 ,@(cdddr lmf-params))
-	       ,@inner-decls
-	       ,@body)))
+	(lambda (.pv-cell. .next-method-call. ,@args+rest-arg)
+	  ,@outer-decls
+	  .pv-cell. .next-method-call.
+	  (macrolet ((pv-env ((pv calls pv-table-symbol pv-parameters)
+			      &rest forms)
+		       (declare (ignore pv-table-symbol pv-parameters))
+		       `(let ((,pv (car .pv-cell.))
+			      (,calls (cdr .pv-cell.)))
+			  (declare ,(make-pv-type-declaration pv)
+				   ,(make-calls-type-declaration calls))
+			  ,pv ,calls
+			  ,@forms)))
+	    (fast-lexical-method-functions 
+	     (,(car lmf-params) .next-method-call. ,req-args ,rest-arg
+	       ,@(cdddr lmf-params))
+	     ,@inner-decls
+	     ,@body)))
 	',initargs))))
 
 ;use arrays and hash tables and the fngen stuff to make this much better.
@@ -1003,28 +1010,28 @@
 (defun method-function-from-fast-function (fmf)
   (declare (type function fmf))
   (let* ((method-function nil) (pv-table nil)
-	 (arg-info (method-function-get fmf ':arg-info))
+	 (arg-info (method-function-get fmf :arg-info))
 	 (nreq (car arg-info))
 	 (restp (cdr arg-info)))
     (setq method-function
-	  #'(lambda (method-args next-methods)
-	      (unless pv-table
-		(setq pv-table (method-function-pv-table fmf)))
-	      (let* ((pv-cell (when pv-table
-				(get-method-function-pv-cell 
-				 method-function method-args pv-table)))
-		     (nm (car next-methods))
-		     (nms (cdr next-methods))
-		     (nmc (when nm
-			    (make-method-call :function (if (std-instance-p nm)
-							    (method-function nm)
-							    nm)
-					      :call-method-args (list nms)))))
-		(if restp
-		    (let* ((rest (nthcdr nreq method-args))
-			   (args (ldiff method-args rest)))
-		      (apply fmf pv-cell nmc (nconc args (list rest))))
-		    (apply fmf pv-cell nmc method-args)))))
+	  (lambda (method-args next-methods)
+	    (unless pv-table
+	      (setq pv-table (method-function-pv-table fmf)))
+	    (let* ((pv-cell (when pv-table
+			      (get-method-function-pv-cell 
+			       method-function method-args pv-table)))
+		   (nm (car next-methods))
+		   (nms (cdr next-methods))
+		   (nmc (when nm
+			  (make-method-call :function (if (std-instance-p nm)
+							  (method-function nm)
+							  nm)
+					    :call-method-args (list nms)))))
+	      (if restp
+		  (let* ((rest (nthcdr nreq method-args))
+			 (args (ldiff method-args rest)))
+		    (apply fmf pv-cell nmc (nconc args (list rest))))
+		  (apply fmf pv-cell nmc method-args)))))
     (let* ((fname (method-function-get fmf :name))
 	   (name `(,(or (get (car fname) 'method-sym)
 			(setf (get (car fname) 'method-sym)
diff --git a/pcl/walk.lisp b/pcl/walk.lisp
index b7eeba3ff22b839289b9d1687e4220d1ff6ecb68..b358342e040cc4a4f0d67698be530b5f2e584e82 100644
--- a/pcl/walk.lisp
+++ b/pcl/walk.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/walk.lisp,v 1.21 2001/05/05 23:34:47 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/walk.lisp,v 1.22 2002/08/26 02:23:16 pmai Exp $")
 ;;;
 ;;; A simple code walker, based IN PART on: (roll the credits)
 ;;;   Larry Masinter's Masterscope
@@ -182,12 +182,12 @@
       :default env
       :variables variables
       :functions
-      (append (mapcar #'(lambda (f)
-			  (cons (car f) (c::make-functional :lexenv env)))
+      (append (mapcar (lambda (f)
+			(cons (car f) (c::make-functional :lexenv env)))
 		      functions)
-	      (mapcar #'(lambda (m)
-			  (list* (car m) 'c::macro
-				 (coerce (cadr m) 'function)))
+	      (mapcar (lambda (m)
+			(list* (car m) 'c::macro
+			       (coerce (cadr m) 'function)))
 		      macros)))))
 
 (defun environment-function (env fn)
@@ -470,9 +470,9 @@
 (defun WALK-FORM (form
 		  &optional environment
 			    (walk-function
-			      #'(lambda (subform context env)
-				  (declare (ignore context env))
-				  subform)))
+			      (lambda (subform context env)
+				(declare (ignore context env))
+				subform)))
   (walker-environment-bind (new-env environment :walk-function walk-function)
     (walk-form-internal form :eval new-env)))
 
@@ -499,48 +499,48 @@
 			 form
 			 &optional environment
 				   (walk-function
-				     #'(lambda (subform context env)
-					 (declare (ignore context env))
-					 subform)))
+				     (lambda (subform context env)
+				       (declare (ignore context env))
+				       subform)))
   (if (eq whole (env-walk-form environment))
       (let ((outer-walk-function (env-walk-function environment)))
 	(throw whole
 	  (walk-form
 	    form
 	    environment
-	    #'(lambda (f c e)
-		;; First loop to make sure the inner walk function
-		;; has done all it wants to do with this form.
-		;; Basically, what we are doing here is providing
-		;; the same contract walk-form-internal normally
-		;; provides to the inner walk function.
-		(let ((inner-result nil)
-		      (inner-no-more-p nil)
-		      (outer-result nil)
-		      (outer-no-more-p nil))
-		  (loop
-		    (multiple-value-setq (inner-result inner-no-more-p)
-					 (funcall walk-function f c e))
-		    (cond (inner-no-more-p (return))
-			  ((not (eq inner-result f)))
-			  ((not (consp inner-result)) (return))
-			  ((get-walker-template (car inner-result)) (return))
-			  (t
-			   (multiple-value-bind (expansion macrop)
-			       (walker-environment-bind
-				     (new-env e :walk-form inner-result)
-				 (macroexpand-1 inner-result new-env))
-			     (if macrop
-				 (setq inner-result expansion)
-				 (return)))))
-		    (setq f inner-result))
-		  (multiple-value-setq (outer-result outer-no-more-p)
-				       (funcall outer-walk-function
-						inner-result
-						c
-						e))
-		  (values outer-result
-			  (and inner-no-more-p outer-no-more-p)))))))
+	    (lambda (f c e)
+	      ;; First loop to make sure the inner walk function
+	      ;; has done all it wants to do with this form.
+	      ;; Basically, what we are doing here is providing
+	      ;; the same contract walk-form-internal normally
+	      ;; provides to the inner walk function.
+	      (let ((inner-result nil)
+		    (inner-no-more-p nil)
+		    (outer-result nil)
+		    (outer-no-more-p nil))
+		(loop
+		 (multiple-value-setq (inner-result inner-no-more-p)
+		   (funcall walk-function f c e))
+		 (cond (inner-no-more-p (return))
+		       ((not (eq inner-result f)))
+		       ((not (consp inner-result)) (return))
+		       ((get-walker-template (car inner-result)) (return))
+		       (t
+			(multiple-value-bind (expansion macrop)
+			    (walker-environment-bind
+			     (new-env e :walk-form inner-result)
+			     (macroexpand-1 inner-result new-env))
+			  (if macrop
+			      (setq inner-result expansion)
+			      (return)))))
+		 (setq f inner-result))
+		(multiple-value-setq (outer-result outer-no-more-p)
+		  (funcall outer-walk-function
+			   inner-result
+			   c
+			   e))
+		(values outer-result
+			(and inner-no-more-p outer-no-more-p)))))))
       (walk-form form environment walk-function)))
 
 ;;;
@@ -712,7 +712,7 @@
       (relist-internal x args nil)))
 
 (defun relist* (x &rest args)
-  (relist-internal x args 't))
+  (relist-internal x args t))
 
 (defun relist-internal (x args *p)
   (if (null (cdr args))
@@ -874,8 +874,8 @@
 	       (walked-body
 		 (walk-declarations 
 		   body
-		   #'(lambda (real-body real-env)
-		       (walk-tagbody-1 real-body context real-env))
+		   (lambda (real-body real-env)
+		     (walk-tagbody-1 real-body context real-env))
 		   new-env)))
 	  (if block-name
 	      (relist*
@@ -908,7 +908,7 @@
 	(body (cdddr form)))
     (walk-form-internal
       `(let ()
-	 (declare (special ,@(mapcar #'(lambda (x) (if (listp x) (car x) x))
+	 (declare (special ,@(mapcar (lambda (x) (if (listp x) (car x) x))
 				     bindings)))
 	 (flet ((.let-if-dummy. () ,@body))
 	   (if ,test
@@ -919,11 +919,11 @@
 
 (defun walk-multiple-value-setq (form context env)
   (let ((vars (cadr form)))
-    (if (some #'(lambda (var)
-		  (variable-symbol-macro-p var env))
+    (if (some (lambda (var)
+		(variable-symbol-macro-p var env))
 	      vars)
-	(let* ((temps (mapcar #'(lambda (var) (declare (ignore var)) (gensym)) vars))
-	       (sets (mapcar #'(lambda (var temp) `(setq ,var ,temp)) vars temps))
+	(let* ((temps (mapcar (lambda (var) (declare (ignore var)) (gensym)) vars))
+	       (sets (mapcar (lambda (var temp) `(setq ,var ,temp)) vars temps))
 	       (expanded `(multiple-value-bind ,temps 
 			       ,(caddr form)
 			     ,@sets))
@@ -943,14 +943,14 @@
 	   (walked-body
 	     (walk-declarations 
 	       body
-	       #'(lambda (real-body real-env)
-		   (setq walked-bindings
-			 (walk-bindings-1 bindings
-					  old-env
-					  new-env
-					  context
-					  nil))
-		   (walk-repeat-eval real-body real-env))
+	       (lambda (real-body real-env)
+		 (setq walked-bindings
+		       (walk-bindings-1 bindings
+					old-env
+					new-env
+					context
+					nil))
+		 (walk-repeat-eval real-body real-env))
 	       new-env)))
       (relist* form mvb walked-bindings mv-form walked-body))))
 
@@ -1055,9 +1055,9 @@
     (walker-environment-bind
 	(new-env old-env
 		 :lexical-variables
-		 (append (mapcar #'(lambda (binding)
-				     `(,(car binding)
-				       :macro . ,(cadr binding)))
+		 (append (mapcar (lambda (binding)
+				   `(,(car binding)
+				     :macro . ,(cadr binding)))
 				 bindings)
 			 (env-lexical-variables old-env)))
       (relist* form 'symbol-macrolet bindings
@@ -1220,21 +1220,21 @@
   (terpri)
   (let ((copy-of-form (copy-tree form))
 	(result (walk-form form nil
-		  #'(lambda (x y env)
-		      (format t "~&Form: ~S ~3T Context: ~A" x y)
-		      (when (symbolp x)
-			(let ((lexical (variable-lexical-p x env))
-			      (special (variable-special-p x env)))
-			  (when lexical
-			    (format t ";~3T")
-			    (format t "lexically bound"))
-			  (when special
-			    (format t ";~3T")
-			    (format t "declared special"))
-			  (when (boundp x)
-			    (format t ";~3T")
-			    (format t "bound: ~S " (eval x)))))
-		      x))))
+		  (lambda (x y env)
+		    (format t "~&Form: ~S ~3T Context: ~A" x y)
+		    (when (symbolp x)
+		      (let ((lexical (variable-lexical-p x env))
+			    (special (variable-special-p x env)))
+			(when lexical
+			  (format t ";~3T")
+			  (format t "lexically bound"))
+			(when special
+			  (format t ";~3T")
+			  (format t "declared special"))
+			(when (boundp x)
+			  (format t ";~3T")
+			  (format t "bound: ~S " (eval x)))))
+		    x))))
     (cond ((not (equal result copy-of-form))
 	   (format t "~%Warning: Result not EQUAL to copy of start."))
 	  ((not (eq result form))
@@ -1412,13 +1412,13 @@
 
 (let ((the-lexical-variables ()))
   (walk-form '(let ((a 1) (b 2))
-		#'(lambda (x) (list a b x y)))
+		(lambda (x) (list a b x y)))
 	     ()
-	     #'(lambda (form context env)
-		 (when (and (symbolp form)
-			    (variable-lexical-p form env))
-		   (push form the-lexical-variables))
-		 form))
+	     (lambda (form context env)
+	       (when (and (symbolp form)
+			  (variable-lexical-p form env))
+		 (push form the-lexical-variables))
+	       form))
   (or (and (= (length the-lexical-variables) 3)
 	   (member 'a the-lexical-variables)
 	   (member 'b the-lexical-variables)