X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsrctran.lisp;h=fc0b639d89bcfa0b3b3557eeda5c957e431298e3;hb=d25e3478acccec70402ff32554669a982be8e281;hp=eca0cc251edfa0d079d8ae83cd1ee10d4c9e05da;hpb=f5522c7149744e4faf34313b18d0d3588d2a9d98;p=sbcl.git

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index eca0cc2..fc0b639 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -1096,7 +1096,7 @@
              (t
               ;; (float x (+0.0)) => (or (member -0.0) (float x (0.0)))
               ;; (float x -0.0) => (or (member -0.0) (float x (0.0)))
-              (list (make-member-type :members (list (float -0.0 hi-val)))
+              (list (make-member-type :members (list (float (load-time-value (make-unportable-float :single-float-negative-zero)) hi-val)))
                     (make-numeric-type :class (numeric-type-class type)
                                        :format (numeric-type-format type)
                                        :complexp :real
@@ -2616,6 +2616,27 @@
              (hi-res (if hi (isqrt hi) '*)))
         (specifier-type `(integer ,lo-res ,hi-res))))))
 
+(defoptimizer (char-code derive-type) ((char))
+  (let ((type (type-intersection (lvar-type char) (specifier-type 'character))))
+    (cond ((member-type-p type)
+           (specifier-type
+            `(member
+              ,@(loop for member in (member-type-members type)
+                      when (characterp member)
+                      collect (char-code member)))))
+          ((sb!kernel::character-set-type-p type)
+           (specifier-type
+            `(or
+              ,@(loop for (low . high)
+                      in (character-set-type-pairs type)
+                      collect `(integer ,low ,high)))))
+          ((csubtypep type (specifier-type 'base-char))
+           (specifier-type
+            `(mod ,base-char-code-limit)))
+          (t
+           (specifier-type
+            `(mod ,char-code-limit))))))
+
 (defoptimizer (code-char derive-type) ((code))
   (let ((type (lvar-type code)))
     ;; FIXME: unions of integral ranges?  It ought to be easier to do
@@ -4083,11 +4104,6 @@
                          *universal-type*))))
         (recurse array-type)))))
 
-;;; Like CMU CL, we use HEAPSORT. However, other than that, this code
-;;; isn't really related to the CMU CL code, since instead of trying
-;;; to generalize the CMU CL code to allow START and END values, this
-;;; code has been written from scratch following Chapter 7 of
-;;; _Introduction to Algorithms_ by Corman, Rivest, and Shamir.
 (define-source-transform sb!impl::sort-vector (vector start end predicate key)
   ;; Like CMU CL, we use HEAPSORT. However, other than that, this code
   ;; isn't really related to the CMU CL code, since instead of trying
@@ -4139,7 +4155,7 @@
                        (start-1 (1- ,',start))
                        (current-heap-size (- ,',end ,',start))
                        (keyfun ,keyfun))
-                   (declare (type (integer -1 #.(1- most-positive-fixnum))
+                   (declare (type (integer -1 #.(1- sb!xc:most-positive-fixnum))
                                   start-1))
                    (declare (type index current-heap-size))
                    (declare (type function keyfun))