From 071afc96281a1dac1938268b1cf35d7e92c7e2c0 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 14 Sep 2003 16:14:54 +0000 Subject: [PATCH] 0.8.3.61: Fix for compiler "cannot convert to SINGLE-FLOAT: " in type inference, as reported PFD sbcl-devel 2003-09-13: ... a slight rewrite to the SIGNED-ZERO-OP methods in src/compiler/srctran.lisp ... not correct in the presence of one integer and one float argument, as coercion could still occur. Break me if you can. --- src/compiler/srctran.lisp | 63 ++++++++++------------------------------ tests/compiler.pure-cload.lisp | 13 +++++++++ version.lisp-expr | 2 +- 3 files changed, 29 insertions(+), 49 deletions(-) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index f6caaae..95dfbab 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -225,6 +225,21 @@ ;;;; numeric-type has everything we want to know. Reason 2 wins for ;;;; now. +;;; Support operations that mimic real arithmetic comparison +;;; operators, but imposing a total order on the floating points such +;;; that negative zeros are strictly less than positive zeros. +(macrolet ((def (name op) + `(defun ,name (x y) + (declare (real x y)) + (if (and (floatp x) (floatp y) (zerop x) (zerop y)) + (,op (float-sign x) (float-sign y)) + (,op x y))))) + (def signed-zero->= >=) + (def signed-zero-> >) + (def signed-zero-= =) + (def signed-zero-< <) + (def signed-zero-<= <=)) + ;;; The basic interval type. It can handle open and closed intervals. ;;; A bound is open if it is a list containing a number, just like ;;; Lisp says. NIL means unbounded. @@ -324,16 +339,8 @@ (make-interval :low (type-bound-number (interval-low x)) :high (type-bound-number (interval-high x)))) -(defun signed-zero->= (x y) - (declare (real x y)) - (or (> x y) - (and (= x y) - (>= (float-sign (float x)) - (float-sign (float y)))))) - ;;; For an interval X, if X >= POINT, return '+. If X <= POINT, return ;;; '-. Otherwise return NIL. -#+nil (defun interval-range-info (x &optional (point 0)) (declare (type interval x)) (let ((lo (interval-low x)) @@ -344,20 +351,6 @@ '-) (t nil)))) -(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)) - (>= x y)))) - (let ((lo (interval-low x)) - (hi (interval-high x))) - (cond ((and lo (signed->= (type-bound-number lo) point)) - '+) - ((and hi (signed->= point (type-bound-number hi))) - '-) - (t - nil))))) ;;; Test to see whether the interval X is bounded. HOW determines the ;;; test, and should be either ABOVE, BELOW, or BOTH. @@ -371,32 +364,6 @@ (both (and (interval-low x) (interval-high x))))) -;;; signed zero comparison functions. Use these functions if we need -;;; to distinguish between signed zeroes. -(defun signed-zero-< (x y) - (declare (real x y)) - (or (< x y) - (and (= x y) - (< (float-sign (float x)) - (float-sign (float y)))))) -(defun signed-zero-> (x y) - (declare (real x y)) - (or (> x y) - (and (= x y) - (> (float-sign (float x)) - (float-sign (float y)))))) -(defun signed-zero-= (x y) - (declare (real x y)) - (and (= x y) - (= (float-sign (float x)) - (float-sign (float y))))) -(defun signed-zero-<= (x y) - (declare (real x y)) - (or (< x y) - (and (= x y) - (<= (float-sign (float x)) - (float-sign (float y)))))) - ;;; See whether the interval X contains the number P, taking into ;;; account that the interval might not be closed. (defun interval-contains-p (p x) diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp index 9fe1951..c7c564c 100644 --- a/tests/compiler.pure-cload.lisp +++ b/tests/compiler.pure-cload.lisp @@ -83,6 +83,19 @@ (signum (logior c b))) (logior a -1)))) +(defun #:foo (b c) + (declare (type (integer -23228343 2) b) + (type (integer -115581022 512244512) c) + (optimize (speed 3) (safety 1) (debug 1))) + (* (* (logorc2 3 (deposit-field 4667947 (byte 14 26) b)) + (deposit-field b (byte 25 27) -30424886)) + (dpb b (byte 23 29) c))) + +(defun #:foo (x y) + (declare (type (integer -1 1000000000000000000000000) x y) + (optimize speed)) + (* x (* y x))) + ;;; bug 282 ;;; ;;; Verify type checking policy in full calls: the callee is supposed diff --git a/version.lisp-expr b/version.lisp-expr index 3fa0939..c97385c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.3.60" +"0.8.3.61" -- 1.7.10.4