diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index 3caa6817b3d239ba3a5af841a314f8cc4730ea33..76c051818d87001f1e34238ab29c8ca97e13beb0 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.70 1998/01/05 18:48:42 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.71 1998/01/05 23:00:23 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -800,13 +800,11 @@
 				      (flatten-helper (cdr x) r))))))
     (flatten-helper x nil)))
 
+;;; Take some type of continuation and massage it so that we get a
+;;; list of the constituent types.  If ARG is *EMPTY-TYPE*, return NIL
+;;; to indicate failure.
+;;;
 (defun prepare-arg-for-derive-type (arg)
-  ;; Take some type of continuation and massage it so that we get a
-  ;; list of the constituent types.  If ARG is *EMPTY-TYPE*, return
-  ;; NIL to indicate failure.
-  ;;
-  ;; WARNING: For some reason if ARG is of type (member 1 a), this
-  ;; routine only gets (member 1).  I don't know why.
   (flet ((listify (arg)
 	   (typecase arg
 	     (numeric-type
@@ -814,28 +812,24 @@
 	     (union-type
 	      (union-type-types arg))
 	     (t
-	      (list arg))))
-	 (convert-member-type (type)
-	   ;; Run down the list of members and convert to a list of
-	   ;; member types.
-	   (mapcar #'(lambda (element)
-		       (if (numberp element)
-			   (specifier-type `(member ,element))
-			   *empty-type*))
-		   (member-type-members type))))
-    (when (eq arg *empty-type*)
-      (return-from prepare-arg-for-derive-type nil))
-    ;; Make sure all args are some type of numeric-type.  For member
-    ;; types, convert the list of members into a union of equivalent
-    ;; single-element member-type's.
-    (let ((new-args (flatten-list (mapcar #'(lambda (x)
-					      (if (member-type-p x)
-						  (convert-member-type x)
-						  x))
-					  (listify arg)))))
-      (if (member *empty-type* new-args)
-	  nil
-	  new-args))))
+	      (list arg)))))
+    (unless (eq arg *empty-type*)
+      ;; Make sure all args are some type of numeric-type.  For member
+      ;; types, convert the list of members into a union of equivalent
+      ;; single-element member-type's.
+      (let ((new-args nil))
+	(dolist (arg (listify arg))
+	  (if (member-type-p arg)
+	      ;; Run down the list of members and convert to a list of
+	      ;; member types.
+	      (dolist (member (member-type-members arg))
+		(push (if (numberp member)
+			  (specifier-type `(member ,member))
+			  *empty-type*)
+		      new-args))
+	      (push arg new-args)))
+	(unless (member *empty-type* new-args)
+	  new-args)))))
 
 ;;; Convert from the standard type convention for which -0.0 and 0.0
 ;;; and equal to an intermediate convention for which they are
@@ -968,18 +962,23 @@
 ;;;
 #-negative-zero-is-not-zero
 (defun convert-back-numeric-type-list (type-list)
-  (declare (type (or list numeric-type) type-list))
-  (cond ((listp type-list)
-	 (collect ((results))
-		  (dolist (type type-list)
-		    (results (if (numeric-type-p type)
-				 (convert-back-numeric-type type)
-				 type)))
-		  (results)))
-	((numeric-type-p type-list)
-	 (convert-back-numeric-type type-list))
-	(t
-	 type-list)))
+  (typecase type-list
+    (list
+     (let ((results '()))
+       (dolist (type type-list)
+	 (if (numeric-type-p type)
+	     (let ((result (convert-back-numeric-type type)))
+	       (if (listp result)
+		   (setf results (append results result))
+		   (push result results)))
+	     (push type results)))
+       results))
+    (numeric-type
+     (convert-back-numeric-type type-list))
+    (union-type
+     (convert-back-numeric-type-list (union-type-types type-list)))
+    (t
+     type-list)))
 
 ;;; ONE-ARG-DERIVE-TYPE
 ;;;
@@ -1018,10 +1017,15 @@
 		  *universal-type*))))
 	;; Run down the list of args and derive the type of each one
 	;; and save all of the results in a list.
-	(let ((result (flatten-list (mapcar #'deriver arg-list))))
-	  (if (rest result)
-	      (make-union-type result)
-	      (first result)))))))
+	(let ((results nil))
+	  (dolist (arg arg-list)
+	    (let ((result (deriver arg)))
+	      (if (listp result)
+		  (setf results (append results result))
+		  (push result results))))
+	  (if (rest results)
+	      (make-union-type results)
+	      (first results)))))))
 
 ;;; TWO-ARG-DERIVE-TYPE
 ;;;
@@ -1104,24 +1108,28 @@
 		    *universal-type*))))
     (let ((same-arg (same-leaf-ref-p arg1 arg2))
 	  (a1 (prepare-arg-for-derive-type (continuation-type arg1)))
-	  (a2 (prepare-arg-for-derive-type (continuation-type arg2)))
-	  (result '()))
+	  (a2 (prepare-arg-for-derive-type (continuation-type arg2))))
       (when (and a1 a2)
-	(if same-arg
-	    ;; Since the args are the same continuation, just run down on
-	    ;; of the lists.
-	    (dolist (x a1)
-	      (push (deriver x x same-arg) result))
-	    ;; Try all pairwise combinations and gather the result
-	    (dolist (x a1)
-	      (dolist (y a2)
-		(push (or (deriver x y same-arg)
-			  (numeric-contagion x y))
-		      result))))
-	(setf result (flatten-list result))
-	(if (rest result)
-	    (make-union-type result)
-	    (first result))))))
+	(let ((results nil))
+	  (if same-arg
+	      ;; Since the args are the same continuation, just run
+	      ;; down the lists.
+	      (dolist (x a1)
+		(let ((result (deriver x x same-arg)))
+		  (if (listp result)
+		      (setf results (append results result))
+		      (push result results))))
+	      ;; Try all pairwise combinations.
+	      (dolist (x a1)
+		(dolist (y a2)
+		  (let ((result (or (deriver x y same-arg)
+				    (numeric-contagion x y))))
+		    (if (listp result)
+			(setf results (append results result))
+			(push result results))))))
+	  (if (rest results)
+	      (make-union-type results)
+	      (first results)))))))
 
 ) ; end progn