diff --git a/code/type.lisp b/code/type.lisp
index 851e409fc102e70910e60853bd553f406d6dc895..029d5d9fb85a9adc5099031049d8a43cb0202b0d 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.24 1998/01/05 22:34:56 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.25 1998/01/08 23:47:25 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1247,16 +1247,36 @@
 ;;; NUMERIC-TYPES-ADJACENT  --  Internal
 ;;;
 ;;;    If the high bound of Low is adjacent to the low bound of High, then
-;;; return T, otherwise NIL.
+;;; return True, otherwise NIL.
 ;;;
 (defun numeric-types-adjacent (low high)
   (let ((low-bound (numeric-type-high low))
 	(high-bound (numeric-type-low high)))
     (cond ((not (and low-bound high-bound)) nil)
+	  ((and (consp low-bound) (consp high-bound)) nil)
 	  ((consp low-bound)
-	   (eql (car low-bound) high-bound))
+	   #-negative-zero-is-not-zero
+	   (let ((low-value (car low-bound)))
+	     (or (eql low-value high-bound)
+		 (and (eql low-value -0f0) (eql high-bound 0f0))
+		 (and (eql low-value 0f0) (eql high-bound -0f0))
+		 (and (eql low-value -0d0) (eql high-bound 0d0))
+		 (and (eql low-value 0d0) (eql high-bound -0d0))))
+	   #+negative-zero-is-not-zero
+	   (eql (car low-value) high-bound))
 	  ((consp high-bound)
-	   (eql (car high-bound) low-bound))
+	   #-negative-zero-is-not-zero
+	   (let ((high-value (car high-bound)))
+	     (or (eql high-value low-bound)
+		 (and (eql high-value -0f0) (eql low-bound 0f0))
+		 (and (eql high-value 0f0) (eql low-bound -0f0))
+		 (and (eql high-value -0d0) (eql low-bound 0d0))
+		 (and (eql high-value 0d0) (eql low-bound -0d0))))
+	   #+negative-zero-is-not-zero
+	   (eql (car high-value) low-bound))
+	  #+negative-zero-is-not-zero
+	  ((or (and (eql low-bound -0f0) (eql high-bound 0f0))
+	       (and (eql low-bound -0d0) (eql high-bound 0d0))))
 	  ((and (eq (numeric-type-class low) 'integer)
 		(eq (numeric-type-class high) 'integer))
 	   (eql (1+ low-bound) high-bound))