From 335f876a9413bf205531e62d89f24ee8cc37e142 Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Mon, 19 Jan 2004 20:15:28 +0000
Subject: [PATCH] o Fix INTERVAL-RANGE-INFO some more.  Put back the previous
 change   (that we backed out) so (abs (the (double-float 0d0) x)) produces  
 the correct result. o Add a kludge to INTERVAL-RANGE-INFO to handle the case
 of an   interval -0.0 to 0.0 specially.  INTERVAL-RANGE-INFO should return  
 NIL instead of '- for this. o The fixes to INTERVAL-RANGE-INFO tickle a bug
 in INTERVAL-SPLIT   where we weren't correctly splitting the the interval
 [-0.0, 0d0]   into 2 intervals correctly.  This was causing the compiler to
 loop   forever deriving things.

This is all a bit kludgy.  Dealing with signed-zeroes is a pain.
---
 compiler/srctran.lisp | 49 ++++++++++++++++++++++++++++++++++++-------
 1 file changed, 41 insertions(+), 8 deletions(-)

diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index c7324714b..0bfc797bc 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.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/srctran.lisp,v 1.142 2004/01/17 03:35:36 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.143 2004/01/19 20:15:28 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -344,10 +344,20 @@
 (defun interval-split (p x &optional close-lower close-upper)
   (declare (type number p)
 	   (type interval x))
-  (list (make-interval :low (copy-interval-limit (interval-low x))
-		       :high (if close-lower p (list p)))
-	(make-interval :low (if close-upper (list p) p)
-		       :high (copy-interval-limit (interval-high x)))))
+  ;; Need to be careful if the lower limit is -0.0 and the split point is 0.
+  (let ((low (interval-low x)))
+    (cond ((and (zerop p)
+		(floatp (bound-value low))
+		(member (bound-value low) '(-0f0 -0d0)))
+	   (list (make-interval :low (copy-interval-limit low)
+				:high (float -0d0 (bound-value low)))
+		 (make-interval :low (if close-upper (list p) p)
+				:high (copy-interval-limit (interval-high x)))))
+	  (t
+	   (list (make-interval :low (copy-interval-limit (interval-low x))
+				:high (if close-lower p (list p)))
+		 (make-interval :low (if close-upper (list p) p)
+				:high (copy-interval-limit (interval-high x))))))))
 
 ;;; INTERVAL-CLOSURE
 ;;;
@@ -367,12 +377,35 @@
 (defun interval-range-info (x &optional (point 0))
   (declare (type interval x))
   (labels ((signed->= (x y)
-	     (if (and (zerop x) (zerop y) (floatp x) (floatp y))
-		 (>= (float-sign x) (float-sign y))
+	     ;; If one of the args is a float, we need to do a float
+	     ;; comparison to get the correct value when testing for a
+	     ;; signed-zero.  That is, we want (>= -0.0 0) to be false.
+	     (if (and (zerop x) (zerop y)
+		      (or (floatp x) (floatp y)))
+		 (>= (float-sign (float x)) (float-sign (float y)))
 		 (>= x y))))
     (let ((lo (interval-low x))
 	  (hi (interval-high x)))
-      (cond ((and lo (signed->= (bound-value lo) point))
+      ;; FIXME!  We get confused if X is the interval -0d0 to 0d0.
+      ;; Special case that.  What else could we be missing?
+      (cond ((and (zerop point)
+		  (numberp (bound-value lo))
+		  (numberp (bound-value hi))
+		  (floatp (bound-value lo))
+		  (zerop (bound-value lo))
+		  (= (bound-value lo) (bound-value hi)))
+	     ;; At this point lo = hi = +/- 0.0.
+	     (cond ((eql (bound-value lo) (bound-value hi))
+		    ;; Both bounds are the same kind of signed 0.  The
+		    ;; sign of the zero tells us the sign of the
+		    ;; interval.
+		    (if (= (float-sign (bound-value lo)) -1)
+			'-
+			'+))
+		   (t
+		    ;; They have different signs
+		    nil)))
+	    ((and lo (signed->= (bound-value lo) point))
 	     '+)
 	    ((and hi (signed->= point (bound-value hi)))
 	     '-)
-- 
GitLab