diff --git a/compiler/constraint.lisp b/compiler/constraint.lisp
index fb29146d865406f645f6d3d53d60d533abfa06f5..4414bdcabdf6a749c83e426e5e7bea2aa94199a9 100644
--- a/compiler/constraint.lisp
+++ b/compiler/constraint.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/constraint.lisp,v 1.17 1997/02/12 22:12:29 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/constraint.lisp,v 1.18 1997/09/08 00:09:22 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -291,7 +291,12 @@
 		 (greater (1+ x))
 		 (t (1- x))))
 	 (bound (x)
-	   (if greater (numeric-type-low x) (numeric-type-high x))))
+	   (if greater (numeric-type-low x) (numeric-type-high x)))
+	 (validate (x)
+	   (if (and (numeric-type-low x) (numeric-type-high x)
+		    (> (numeric-type-low x) (numeric-type-high x)))
+	       *empty-type*
+	       x)))
     (let* ((x-bound (bound x))
 	   (y-bound (exclude (bound y)))
 	   (new-bound (cond ((not x-bound) y-bound)
@@ -302,7 +307,7 @@
       (if greater
 	  (setf (numeric-type-low res) new-bound)
 	  (setf (numeric-type-high res) new-bound))
-      res)))
+      (validate res))))
 
   
 ;;; FLOAT-TYPE-P  --  Internal
@@ -350,10 +355,13 @@
 	       ;; upper bound because the open bound doesn't
 	       ;; contain the bound, so choose an open lower
 	       ;; bound.
-	       (set-bound res (or (consp x) (consp y))))))
-    #+nil
-    (format t "~%constraint-float-type:~%  ~s~%  ~s~%  ~s~%  ~s~%"
-	    x y greater or-equal)
+	       (set-bound res (or (consp x) (consp y)))))
+	   (validate (x)
+	     (let ((x-lo (numeric-type-low x))
+		   (x-hi (numeric-type-high x)))
+	       (if (and x-lo x-hi (> (bound-value x-lo) (bound-value x-hi)))
+		   *empty-type*
+		   x))))
     (let* ((x-bound (bound x))
 	   (y-bound (exclude (bound y)))
 	   (new-bound (cond ((not x-bound)
@@ -365,15 +373,10 @@
 			    (t
 			     (min-upper-bound x-bound y-bound))))
 	   (res (copy-numeric-type x)))
-      #+nil
-      (format t "x-bound, y-bound, new-bound = ~s, ~s, ~s~%"
-	      x-bound y-bound new-bound)
       (if greater
 	  (setf (numeric-type-low res) new-bound)
 	  (setf (numeric-type-high res) new-bound))
-      #+nil
-      (format t "~&constrain-float-type returns ~s~%" res)
-      res)))
+      (validate res))))
 
   
 ;;; CONSTRAIN-REF-TYPE  --  Internal