X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftypep.lisp;h=0df87b1c2f89099f845d35ef37ee4d2a01423e3e;hb=8d490a4d6b9d7f156cf503826b3e3195e6f3ad39;hp=2c200f3899a954c506147d1f3df7860f4c533bb7;hpb=2d3cb6dba6461e98744eca2a1df4f770cea468ca;p=sbcl.git

diff --git a/src/code/typep.lisp b/src/code/typep.lisp
index 2c200f3..0df87b1 100644
--- a/src/code/typep.lisp
+++ b/src/code/typep.lisp
@@ -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)))
@@ -77,37 +76,6 @@
 		    (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
-	       (and (complexp object)
-		    (bound-test (realpart object))
-		    (bound-test (imagpart object))))
-	      (:real
-	       (and (not (complexp object))
 		    (bound-test object)))))))
     (array-type
      (and (arrayp object)
@@ -149,6 +117,14 @@
      (and (consp object)
 	  (%%typep (car object) (cons-type-car-type type))
 	  (%%typep (cdr object) (cons-type-cdr-type type))))
+    (character-set-type
+     (and (characterp object)
+         (let ((code (char-code object))
+               (pairs (character-set-type-pairs type)))
+           (dolist (pair pairs nil)
+             (destructuring-bind (low . high) pair
+               (when (<= low code high)
+                 (return t)))))))
     (unknown-type
      ;; dunno how to do this ANSIly -- WHN 19990413
      #+sb-xc-host (error "stub: %%TYPEP UNKNOWN-TYPE in xcompilation host")