diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp
index 1ebf859c0ccf0965f474006302eeb84d8c9737df..408e56f20fa81ccb26453bfe45ba70ef80759721 100644
--- a/compiler/fndb.lisp
+++ b/compiler/fndb.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/fndb.lisp,v 1.120 2003/07/30 16:51:43 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.121 2003/08/02 11:52:15 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -398,10 +398,10 @@
 (defknown length (sequence) index (foldable flushable))
 
 (defknown reverse (sequence) consed-sequence (flushable)
-  :derive-type #'result-type-first-arg)
+  :derive-type #'result-type-first-arg/reverse)
 
 (defknown nreverse (sequence) sequence ()
-  :derive-type #'result-type-first-arg)
+  :derive-type #'result-type-first-arg/reverse)
 
 (defknown make-sequence (type-specifier index &key (:initial-element t)) consed-sequence
   (movable flushable unsafe)
diff --git a/compiler/knownfun.lisp b/compiler/knownfun.lisp
index 287c807d45b3e2d46433a6188d19991727089683..6cbb5af2baf1450f015c2f46622f164bdfcd27f9 100644
--- a/compiler/knownfun.lisp
+++ b/compiler/knownfun.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/knownfun.lisp,v 1.24 2003/07/30 15:33:05 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/knownfun.lisp,v 1.25 2003/08/02 11:52:15 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -242,7 +242,34 @@
   (declare (type combination call))
   (let ((cont (first (combination-args call))))
     (when cont (continuation-type cont))))
-;;;
+
+(defun result-type-first-arg/reverse (call)
+  (declare (type combination call))
+  (let ((cont (first (combination-args call))))
+    (when cont
+      (let ((type (continuation-type cont)))
+	(if (cons-type-p type)
+	    (reversed-cons-type type)
+	    type)))))
+
+(defun reversed-cons-type (type)
+  (declare (type cons-type type))
+  (collect ((car-types))
+    (let ((cdr-type nil))
+      (loop for x = type then (cons-type-cdr-type x)
+	    while (cons-type-p x) do
+	    (let ((car (cons-type-car-type x))
+		  (cdr (cons-type-cdr-type x)))
+	      (car-types (type-specifier car))
+	      (setq cdr-type cdr)))
+      (let ((cons-type (specifier-type 'cons)))
+	(if (types-intersect cons-type cdr-type)
+	    cons-type
+	    (let ((spec 'null))
+	      (dolist (x (car-types))
+		(setq spec `(cons ,x ,spec)))
+	      (specifier-type spec)))))))
+
 (defun result-type-last-arg (call)
   (declare (type combination call))
   (let ((cont (car (last (combination-args call)))))