diff --git a/code/type.lisp b/code/type.lisp
index 25db44972a9a8c77450de799ff2b17b6dcba2062..b3a94756958ac4e2cf4ed293c1f007ee65e7d7bd 100644
--- a/code/type.lisp
+++ b/code/type.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/code/type.lisp,v 1.62 2003/05/08 14:52:04 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.63 2003/07/03 12:14:03 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -664,12 +664,14 @@
 ;;; The union or intersection of two FUNCTION types is FUNCTION.
 ;;;
 (define-type-method (function :simple-union) (type1 type2)
-  (declare (ignore type1 type2))
-  (specifier-type 'function))
+  (if (type= type1 type2)
+      type1
+      (specifier-type 'function)))
 
 (define-type-method (function :simple-intersection) (type1 type2)
-  (declare (ignore type1 type2))
-  (values (specifier-type 'function) t))
+  (if (type= type1 type2)
+      type1
+      (values (specifier-type 'function) t)))
 
 
 ;;; ### Not very real, but good enough for redefining transforms according to
@@ -1247,12 +1249,15 @@
 	 ;; to do that, so let it handle it.
 	 (type-intersection type1 type2))
 	;;
-	;; (AND (FUNCTION (T) T) GENERIC-FUNCTION) for instance.
+	;; (AND (FUNCTION (T) T) GENERIC-FUNCTION) for instance, but
+	;; not (AND (FUNCTION (T) T) (FUNCTION (T) T)).
 	((let ((function (specifier-type 'function)))
 	   (or (and (function-type-p type1)
+		    (not (or (function-type-p type2) (eq function type2)))
 		    (csubtypep type2 function)
 		    (not (csubtypep function type2)))
 	       (and (function-type-p type2)
+		    (not (or (function-type-p type1) (eq function type1)))
 		    (csubtypep type1 function)
 		    (not (csubtypep function type1)))))
 	 nil)