Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/code early-type.lisp,1.33,1.34 late-type.lisp,1.80,1.81 typep.lisp,1.15,1.16
|
From: Christophe R. <cr...@us...> - 2003-05-03 15:32:32
|
Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv17476/src/code
Modified Files:
early-type.lisp late-type.lisp typep.lisp
Log Message:
0.8alpha.0.8:
Delete NEGATIVE-ZERO-IS-NOT-ZERO feature conditional, and all
code compiled when it is active, as (following discussions with
Raymond Toy) it has been superseded by accurate MEMBER type
methods.
... mention its loss in NEWS, just in case anyone has actually
been using it (highly unlikely).
Index: early-type.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-type.lisp,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- early-type.lisp 2 May 2003 14:56:39 -0000 1.33
+++ early-type.lisp 3 May 2003 15:32:28 -0000 1.34
@@ -260,22 +260,6 @@
(if (consp high)
(1- (type-bound-number high))
high)))
- #!+negative-zero-is-not-zero
- (float
- ;; Canonicalize a low bound of (-0.0) to 0.0, and a high
- ;; bound of (+0.0) to -0.0.
- (values (if (and (consp low)
- (floatp (car low))
- (zerop (car low))
- (minusp (float-sign (car low))))
- (float 0.0 (car low))
- low)
- (if (and (consp high)
- (floatp (car high))
- (zerop (car high))
- (plusp (float-sign (car high))))
- (float -0.0 (car high))
- high)))
(t
;; no canonicalization necessary
(values low high)))
Index: late-type.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/late-type.lisp,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -d -r1.80 -r1.81
--- late-type.lisp 2 May 2003 14:56:39 -0000 1.80
+++ late-type.lisp 3 May 2003 15:32:28 -0000 1.81
@@ -1453,7 +1453,6 @@
;;;
;;; This is for comparing bounds of the same kind, e.g. upper and
;;; upper. Use NUMERIC-BOUND-TEST* for different kinds of bounds.
-#!-negative-zero-is-not-zero
(defmacro numeric-bound-test (x y closed open)
`(cond ((not ,y) t)
((not ,x) nil)
@@ -1466,32 +1465,12 @@
(,open ,x (car ,y))
(,closed ,x ,y)))))
-#!+negative-zero-is-not-zero
-(defmacro numeric-bound-test-zero (op x y)
- `(if (and (zerop ,x) (zerop ,y) (floatp ,x) (floatp ,y))
- (,op (float-sign ,x) (float-sign ,y))
- (,op ,x ,y)))
-
-#!+negative-zero-is-not-zero
-(defmacro numeric-bound-test (x y closed open)
- `(cond ((not ,y) t)
- ((not ,x) nil)
- ((consp ,x)
- (if (consp ,y)
- (numeric-bound-test-zero ,closed (car ,x) (car ,y))
- (numeric-bound-test-zero ,closed (car ,x) ,y)))
- (t
- (if (consp ,y)
- (numeric-bound-test-zero ,open ,x (car ,y))
- (numeric-bound-test-zero ,closed ,x ,y)))))
-
;;; This is used to compare upper and lower bounds. This is different
;;; from the same-bound case:
;;; -- Since X = NIL is -infinity, whereas y = NIL is +infinity, we
;;; return true if *either* arg is NIL.
;;; -- an open inner bound is "greater" and also squeezes the interval,
;;; causing us to use the OPEN test for those cases as well.
-#!-negative-zero-is-not-zero
(defmacro numeric-bound-test* (x y closed open)
`(cond ((not ,y) t)
((not ,x) t)
@@ -1504,19 +1483,6 @@
(,open ,x (car ,y))
(,closed ,x ,y)))))
-#!+negative-zero-is-not-zero
-(defmacro numeric-bound-test* (x y closed open)
- `(cond ((not ,y) t)
- ((not ,x) t)
- ((consp ,x)
- (if (consp ,y)
- (numeric-bound-test-zero ,open (car ,x) (car ,y))
- (numeric-bound-test-zero ,open (car ,x) ,y)))
- (t
- (if (consp ,y)
- (numeric-bound-test-zero ,open ,x (car ,y))
- (numeric-bound-test-zero ,closed ,x ,y)))))
-
;;; Return whichever of the numeric bounds X and Y is "maximal"
;;; according to the predicates CLOSED (e.g. >=) and OPEN (e.g. >).
;;; This is only meaningful for maximizing like bounds, i.e. upper and
@@ -1580,28 +1546,19 @@
(cond ((not (and low-bound high-bound)) nil)
((and (consp low-bound) (consp high-bound)) nil)
((consp low-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-bound) high-bound))
+ (and (eql low-value 0d0) (eql high-bound -0d0)))))
((consp high-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-bound) 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 (eql high-value 0d0) (eql low-bound -0d0)))))
((and (eq (numeric-type-class low) 'integer)
(eq (numeric-type-class high) 'integer))
(eql (1+ low-bound) high-bound))
@@ -2358,7 +2315,6 @@
(let (ms numbers)
(dolist (m (remove-duplicates members))
(typecase m
- #!-negative-zero-is-not-zero
(float (if (zerop m)
(push m ms)
(push (ctype-of m) numbers)))
Index: typep.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/typep.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- typep.lisp 24 Mar 2003 18:39:02 -0000 1.15
+++ typep.lisp 3 May 2003 15:32:28 -0000 1.16
@@ -59,7 +59,6 @@
(long-float (typep num 'long-float))
((nil) (floatp num))))
((nil) t)))
- #!-negative-zero-is-not-zero
(flet ((bound-test (val)
(let ((low (numeric-type-low type))
(high (numeric-type-high type)))
@@ -69,37 +68,6 @@
(cond ((null high) t)
((listp high) (< val (car high)))
(t (<= val high)))))))
- (ecase (numeric-type-complexp type)
- ((nil) t)
- (:complex
- (and (complexp object)
- (bound-test (realpart object))
- (bound-test (imagpart object))))
- (:real
- (and (not (complexp object))
- (bound-test object)))))
- #!+negative-zero-is-not-zero
- (labels ((signed-> (x y)
- (if (and (zerop x) (zerop y) (floatp x) (floatp y))
- (> (float-sign x) (float-sign y))
- (> x y)))
- (signed->= (x y)
- (if (and (zerop x) (zerop y) (floatp x) (floatp y))
- (>= (float-sign x) (float-sign y))
- (>= x y)))
- (bound-test (val)
- (let ((low (numeric-type-low type))
- (high (numeric-type-high type)))
- (and (cond ((null low) t)
- ((listp low)
- (signed-> val (car low)))
- (t
- (signed->= val low)))
- (cond ((null high) t)
- ((listp high)
- (signed-> (car high) val))
- (t
- (signed->= high val)))))))
(ecase (numeric-type-complexp type)
((nil) t)
(:complex
|