(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
(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
*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
(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))