X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftypetran.lisp;h=e1983791e4b269399efbd3505756eeaea9be1938;hb=df679ed627975948b1cee190f4d79c397588c43e;hp=06f0de1b1fdbb4bd7c39785c640811a0c38f9783;hpb=2d3cb6dba6461e98744eca2a1df4f770cea468ca;p=sbcl.git

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 06f0de1..e198379 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -155,7 +155,6 @@
 ;;; binds specified by TYPE. BASE is the name of the base type, for
 ;;; declaration. We make SAFETY locally 0 to inhibit any checking of
 ;;; this assertion.
-#!-negative-zero-is-not-zero
 (defun transform-numeric-bound-test (n-object type base)
   (declare (type numeric-type type))
   (let ((low (numeric-type-low type))
@@ -171,49 +170,6 @@
 		    `((< (the ,base ,n-object) ,(car high)))
 		    `((<= (the ,base ,n-object) ,high))))))))
 
-#!+negative-zero-is-not-zero
-(defun transform-numeric-bound-test (n-object type base)
-  (declare (type numeric-type type))
-  (let ((low (numeric-type-low type))
-	(high (numeric-type-high type))
-	(float-type-p (csubtypep type (specifier-type 'float)))
-	(x (gensym))
-	(y (gensym)))
-    `(locally
-       (declare (optimize (safety 0)))
-       (and ,@(when low
-		(if (consp low)
-		    `((let ((,x (the ,base ,n-object))
-			    (,y ,(car low)))
-			,(if (not float-type-p)
-			    `(> ,x ,y)
-			    `(if (and (zerop ,x) (zerop ,y))
-				 (> (float-sign ,x) (float-sign ,y))
-				 (> ,x ,y)))))
-		    `((let ((,x (the ,base ,n-object))
-			    (,y ,low))
-			,(if (not float-type-p)
-			    `(>= ,x ,y)
-			    `(if (and (zerop ,x) (zerop ,y))
-				 (>= (float-sign ,x) (float-sign ,y))
-				 (>= ,x ,y)))))))
-	    ,@(when high
-		(if (consp high)
-		    `((let ((,x (the ,base ,n-object))
-			    (,y ,(car high)))
-			,(if (not float-type-p)
-			     `(< ,x ,y)
-			     `(if (and (zerop ,x) (zerop ,y))
-				  (< (float-sign ,x) (float-sign ,y))
-				  (< ,x ,y)))))
-		    `((let ((,x (the ,base ,n-object))
-			    (,y ,high))
-			,(if (not float-type-p)
-			     `(<= ,x ,y)
-			     `(if (and (zerop ,x) (zerop ,y))
-				  (<= (float-sign ,x) (float-sign ,y))
-				  (<= ,x ,y)))))))))))
-
 ;;; Do source transformation of a test of a known numeric type. We can
 ;;; assume that the type doesn't have a corresponding predicate, since
 ;;; those types have already been picked off. In particular, CLASS
@@ -554,7 +510,12 @@
 	     ((csubtypep tspec (specifier-type 'float))
 	      '(%single-float x))
 	     ((and (csubtypep tspec (specifier-type 'simple-vector))
-		   (policy node (< safety 3)))
+		   ;; Can we avoid checking for dimension issues like
+		   ;; (COERCE FOO '(SIMPLE-VECTOR 5)) returning a
+		   ;; vector of length 6?
+		   (or (policy node (< safety 3)) ; no need in unsafe code
+		       (and (array-type-p tspec) ; no need when no dimensions
+			    (equal (array-type-dimensions tspec) '(*)))))
 	      `(if (simple-vector-p x)
 		   x
 		   (replace (make-array (length x)) x)))
@@ -562,3 +523,4 @@
 	     (t
 	      (give-up-ir1-transform)))))))
 
+