X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fconstraint.lisp;h=328056a70e08f3b33eb3412c06a3d9b79c8bb627;hb=872175cd9cb5b4966a36d4bd92421cc407a0355b;hp=0283b382c0a089c18a874962f6af6a9441caa576;hpb=0b5610d8a220a4b20cbeac958953ca4d67c00038;p=sbcl.git

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 0283b38..328056a 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -245,23 +245,16 @@
 		 (greater (1+ x))
 		 (t (1- x))))
 	 (bound (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)))
+	   (if greater (numeric-type-low x) (numeric-type-high x))))
     (let* ((x-bound (bound x))
 	   (y-bound (exclude (bound y)))
 	   (new-bound (cond ((not x-bound) y-bound)
 			    ((not y-bound) x-bound)
 			    (greater (max x-bound y-bound))
-			    (t (min x-bound y-bound))))
-	   (res (copy-numeric-type x)))
+			    (t (min x-bound y-bound)))))
       (if greater
-	  (setf (numeric-type-low res) new-bound)
-	  (setf (numeric-type-high res) new-bound))
-      (validate res))))
+	  (modified-numeric-type x :low new-bound)
+	  (modified-numeric-type x :high new-bound)))))
 
 ;;; Return true if X is a float NUMERIC-TYPE.
 (defun float-type-p (x)
@@ -273,12 +266,13 @@
 ;;; Exactly the same as CONSTRAIN-INTEGER-TYPE, but for float numbers.
 (defun constrain-float-type (x y greater or-equal)
   (declare (type numeric-type x y))
-  ;; Unless :PROPAGATE-FLOAT-TYPE is in target features, then
-  ;; SB!C::BOUND-VALUE (used in the code below) is not defined, so we
-  ;; just return X without trying to calculate additional constraints.
-  #!-propagate-float-type (declare (ignore y greater or-equal))
-  #!-propagate-float-type x
-  #!+propagate-float-type
+  (declare (ignorable x y greater or-equal)) ; for CROSS-FLOAT-INFINITY-KLUDGE
+  
+  (aver (eql (numeric-type-class x) 'float))
+  (aver (eql (numeric-type-class y) 'float))
+  #+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
+  x
+  #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
   (labels ((exclude (x)
 	     (cond ((not x) nil)
 		   (or-equal x)
@@ -293,8 +287,8 @@
 	   (bound (x)
 	     (if greater (numeric-type-low x) (numeric-type-high x)))
 	   (max-lower-bound (x y)
-	     ;; Both x and y are not null. Find the max.
-	     (let ((res (max (bound-value x) (bound-value y))))
+	     ;; Both X and Y are not null. Find the max.
+	     (let ((res (max (type-bound-number x) (type-bound-number y))))
 	       ;; An open lower bound is greater than a close
 	       ;; lower bound because the open bound doesn't
 	       ;; contain the bound, so choose an open lower
@@ -302,19 +296,13 @@
 	       (set-bound res (or (consp x) (consp y)))))
 	   (min-upper-bound (x y)
 	     ;; Same as above, but for the min of upper bounds
-	     ;; Both x and y are not null. Find the min.
-	     (let ((res (min (bound-value x) (bound-value y))))
+	     ;; Both X and Y are not null. Find the min.
+	     (let ((res (min (type-bound-number x) (type-bound-number y))))
 	       ;; An open upper bound is less than a closed
 	       ;; 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)))))
-	   (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))))
+	       (set-bound res (or (consp x) (consp y))))))
     (let* ((x-bound (bound x))
 	   (y-bound (exclude (bound y)))
 	   (new-bound (cond ((not x-bound)
@@ -324,12 +312,10 @@
 			    (greater
 			     (max-lower-bound x-bound y-bound))
 			    (t
-			     (min-upper-bound x-bound y-bound))))
-	   (res (copy-numeric-type x)))
+			     (min-upper-bound x-bound y-bound)))))
       (if greater
-	  (setf (numeric-type-low res) new-bound)
-	  (setf (numeric-type-high res) new-bound))
-      (validate res))))
+	  (modified-numeric-type x :low new-bound)
+	  (modified-numeric-type x :high new-bound)))))
 
 ;;; Given the set of CONSTRAINTS for a variable and the current set of
 ;;; restrictions from flow analysis IN, set the type for REF
@@ -351,7 +337,7 @@
 	    (typep
 	     (if not-p
 		 (setq not-res (type-union not-res other))
-		 (setq res (type-intersection res other))))
+		 (setq res (type-approx-intersection2 res other))))
 	    (eql
 	     (let ((other-type (leaf-type other)))
 	       (if not-p
@@ -370,7 +356,6 @@
 		      (let ((greater (if not-p (not greater) greater)))
 			(setq res
 			      (constrain-integer-type res y greater not-p)))))
-		   #!+constrain-float-type
 		   ((and (float-type-p res) (float-type-p y))
 		    (let ((greater (eq kind '>)))
 		      (let ((greater (if not-p (not greater) greater)))
@@ -384,7 +369,7 @@
 		    (csubtypep (specifier-type 'null) not-res)
 		    (eq (continuation-asserted-type cont) *wild-type*))
 	       (setf (node-derived-type ref) *wild-type*)
-	       (change-ref-leaf ref (find-constant 't)))
+	       (change-ref-leaf ref (find-constant t)))
 	      (t
 	       (derive-node-type ref (or (type-difference res not-res)
 					 res)))))))
@@ -527,4 +512,3 @@
     (use-result-constraints block))
 
   (values))
-