diff --git a/code/seq.lisp b/code/seq.lisp
index 80f5dd9c5f1119550771898dd75b375b9b5620f6..4da6e5deb18d5cb371cc582c9dbef6521d99a247 100644
--- a/code/seq.lisp
+++ b/code/seq.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.9 1991/08/13 13:59:31 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.10 1991/10/01 16:12:59 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -700,47 +700,50 @@
 
 (eval-when (compile eval)
 
-(defmacro mumble-reduce (function sequence start end initial-value ref)
+(defmacro mumble-reduce (function sequence key start end initial-value ref)
   `(do ((index ,start (1+ index))
 	(value ,initial-value))
        ((= index (the fixnum ,end)) value)
      (declare (fixnum index))
-     (setq value (funcall ,function value (,ref ,sequence index)))))
+     (setq value (funcall ,function value
+			  (apply-key ,key (,ref ,sequence index))))))
 
-(defmacro mumble-reduce-from-end (function sequence start end initial-value ref)
+(defmacro mumble-reduce-from-end (function sequence key start end initial-value ref)
   `(do ((index (1- ,end) (1- index))
 	(value ,initial-value)
 	(terminus (1- ,start)))
        ((= index terminus) value)
      (declare (fixnum index terminus))
-     (setq value (funcall ,function (,ref ,sequence index) value))))
+     (setq value (funcall ,function
+			  (apply-key ,key (,ref ,sequence index))
+			  value))))
 
-(defmacro list-reduce (function sequence start end initial-value ivp)
+(defmacro list-reduce (function sequence key start end initial-value ivp)
   `(let ((sequence (nthcdr ,start ,sequence)))
      (do ((count (if ,ivp ,start (1+ (the fixnum ,start)))
 		 (1+ count))
 	  (sequence (if ,ivp sequence (cdr sequence))
 		    (cdr sequence))
-	  (value (if ,ivp ,initial-value (car sequence))
-		 (funcall ,function value (car sequence))))
+	  (value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
+		 (funcall ,function value (apply-key ,key (car sequence)))))
 	 ((= count (the fixnum ,end)) value)
        (declare (fixnum count)))))
 
-(defmacro list-reduce-from-end (function sequence start end initial-value ivp)
+(defmacro list-reduce-from-end (function sequence key start end initial-value ivp)
   `(let ((sequence (nthcdr (- (the fixnum (length ,sequence)) (the fixnum ,end))
 			   (reverse ,sequence))))
      (do ((count (if ,ivp ,start (1+ (the fixnum ,start)))
 		 (1+ count))
 	  (sequence (if ,ivp sequence (cdr sequence))
 		    (cdr sequence))
-	  (value (if ,ivp ,initial-value (car sequence))
-		 (funcall ,function (car sequence) value)))
+	  (value (if ,ivp ,initial-value (apply-key ,key (car sequence)))
+		 (funcall ,function (apply-key ,key (car sequence)) value)))
 	 ((= count (the fixnum ,end)) value)
        (declare (fixnum count)))))
 
 )
 
-(defun reduce (function sequence &key from-end (start 0)
+(defun reduce (function sequence &key key from-end (start 0)
 			end (initial-value nil ivp))
   "The specified Sequence is ``reduced'' using the given Function.
   See manual for details."
@@ -750,18 +753,20 @@
 	 (if ivp initial-value (funcall function)))
 	((listp sequence)
 	 (if from-end
-	     (list-reduce-from-end function sequence start end initial-value ivp)
-	     (list-reduce function sequence start end initial-value ivp)))
+	     (list-reduce-from-end function sequence key start end
+				   initial-value ivp)
+	     (list-reduce function sequence key start end initial-value ivp)))
 	(from-end
 	 (when (not ivp)
 	   (setq end (1- (the fixnum end)))
-	   (setq initial-value (aref sequence end)))
-	 (mumble-reduce-from-end function sequence start end initial-value aref))
+	   (setq initial-value (apply-key key (aref sequence end))))
+	 (mumble-reduce-from-end function sequence key start end
+				 initial-value aref))
 	(t
 	 (when (not ivp)
-	   (setq initial-value (aref sequence start))
+	   (setq initial-value (apply-key key (aref sequence start)))
 	   (setq start (1+ start)))
-	 (mumble-reduce function sequence start end initial-value aref))))
+	 (mumble-reduce function sequence key start end initial-value aref))))
 
 
 ;;; Coerce:
@@ -1461,8 +1466,8 @@
 				   (normal
 				    (if test-not
 					(not 
-					 (funcall test-not (apply-key key elt) old))
-					(funcall test (apply-key key elt) old)))
+					 (funcall test-not old (apply-key key elt)))
+					(funcall test old (apply-key key elt))))
 				   (if (funcall test (apply-key key elt)))
 				   (if-not (not (funcall test (apply-key key elt)))))
 			    (setq count (1- count))
@@ -1494,8 +1499,8 @@
 	    (cond ((case pred
 			  (normal
 			    (if test-not
-				(not (funcall test-not (apply-key key elt) old))
-				(funcall test (apply-key key elt) old)))
+				(not (funcall test-not old (apply-key key elt)))
+				(funcall test old (apply-key key elt))))
 			  (if (funcall test (apply-key key elt)))
 			  (if-not (not (funcall test (apply-key key elt)))))
 		   (setq count (1- count))
@@ -1540,8 +1545,7 @@
   for details."
   (declare (fixnum start count))
   (when (null end) (setf end (length sequence)))
-  (let ((length (length sequence))
-	(old (apply-key key old)))
+  (let ((length (length sequence)))
     (declare (fixnum length))
     (subst-dispatch 'normal)))
 
@@ -1588,21 +1592,18 @@
   may be destroyed.  See manual for details."
   (declare (fixnum count start))
   (when (null end) (setf end (length sequence)))
-  (let ((incrementer 1))
-    (declare (fixnum incrementer))
-    (if from-end
-	(psetq start (1- end)
-	       end (1- start)
-	       incrementer -1))
-    (if (listp sequence)
-	(if from-end
-	    (nreverse (nlist-substitute*
-		       new old (nreverse (the list sequence))
-		       test test-not start end count key))
-	    (nlist-substitute* new old sequence
-			       test test-not start end count key))
-	(nvector-substitute* new old sequence incrementer
-			     test test-not start end count key))))
+  (if (listp sequence)
+      (if from-end
+	  (nreverse (nlist-substitute*
+		     new old (nreverse (the list sequence))
+		     test test-not start end count key))
+	  (nlist-substitute* new old sequence
+			     test test-not start end count key))
+      (if from-end
+	  (nvector-substitute* new old sequence -1
+			       test test-not (1- end) (1- start) count key)
+	  (nvector-substitute* new old sequence 1
+			       test test-not start end count key))))
 
 (defun nlist-substitute* (new old sequence test test-not start end count key)
   (declare (fixnum start count end))
@@ -1611,8 +1612,8 @@
       ((or (= index end) (null list) (= count 0)) sequence)
     (declare (fixnum index))
     (when (if test-not
-	      (not (funcall test-not (apply-key key (car list)) old))
-	      (funcall test (apply-key key (car list)) old))
+	      (not (funcall test-not old (apply-key key (car list))))
+	      (funcall test old (apply-key key (car list))))
       (rplaca list new)
       (setq count (1- count)))))
 
@@ -1623,8 +1624,8 @@
       ((or (= index end) (= count 0)) sequence)
     (declare (fixnum index))
     (when (if test-not
-	      (not (funcall test-not (apply-key key (aref sequence index)) old))
-	      (funcall test (apply-key key (aref sequence index)) old))
+	      (not (funcall test-not old (apply-key key (aref sequence index))))
+	      (funcall test old (apply-key key (aref sequence index))))
       (setf (aref sequence index) new)
       (setq count (1- count)))))
 
@@ -1632,18 +1633,13 @@
 ;;; NSubstitute-If:
 
 (defun nsubstitute-if (new test sequence &key from-end (start 0)
-			end (count most-positive-fixnum) key)
+			   end (count most-positive-fixnum) key)
   "Returns a sequence of the same kind as Sequence with the same elements
-  except that all elements satisfying the Test are replaced with New.  The
-  Sequence may be destroyed.  See manual for details."
+   except that all elements satisfying the Test are replaced with New.  The
+   Sequence may be destroyed.  See manual for details."
   (declare (fixnum start count))
-  (let ((incrementer 1)
-	(end (or end (length sequence))))
-    (declare (fixnum incrementer end))
-    (if from-end
-	(psetq start (1- end)
-	       end (1- start)
-	       incrementer -1))
+  (let ((end (or end (length sequence))))
+    (declare (fixnum end))
     (if (listp sequence)
 	(if from-end
 	    (nreverse (nlist-substitute-if*
@@ -1651,8 +1647,11 @@
 		       start end count key))
 	    (nlist-substitute-if* new test sequence
 				  start end count key))
-	(nvector-substitute-if* new test sequence incrementer
-				start end count key))))
+	(if from-end
+	    (nvector-substitute-if* new test sequence -1
+				    (1- end) (1- start) count key)
+	    (nvector-substitute-if* new test sequence 1
+				    start end count key)))))
 
 (defun nlist-substitute-if* (new test sequence start end count key)
   (declare (fixnum end))
@@ -1675,27 +1674,25 @@
 ;;; NSubstitute-If-Not:
 
 (defun nsubstitute-if-not (new test sequence &key from-end (start 0)
-			    end (count most-positive-fixnum) key)
+			       end (count most-positive-fixnum) key)
   "Returns a sequence of the same kind as Sequence with the same elements
-  except that all elements not satisfying the Test are replaced with New.
-  The Sequence may be destroyed.  See manual for details."
+   except that all elements not satisfying the Test are replaced with New.
+   The Sequence may be destroyed.  See manual for details."
   (declare (fixnum start count))
   (let ((end (or end (length sequence))))
     (declare (fixnum end))
-    (let ((incrementer 1))
-      (if from-end
-	  (psetq start (1- end)
-		 end (1- start)
-		 incrementer -1))
-      (if (listp sequence)
-	  (if from-end
-	      (nreverse (nlist-substitute-if-not*
-			 new test (nreverse (the list sequence))
-			 start end count key))
-	      (nlist-substitute-if-not* new test sequence
-					start end count key))
-	  (nvector-substitute-if-not* new test sequence incrementer
-				      start end count key)))))
+    (if (listp sequence)
+	(if from-end
+	    (nreverse (nlist-substitute-if-not*
+		       new test (nreverse (the list sequence))
+		       start end count key))
+	    (nlist-substitute-if-not* new test sequence
+				      start end count key))
+	(if from-end
+	    (nvector-substitute-if-not* new test sequence -1
+					(1- end) (1- start) count key)
+	    (nvector-substitute-if-not* new test sequence 1
+					start end count key)))))
 
 (defun nlist-substitute-if-not* (new test sequence start end count key)
   (declare (fixnum end))