- (numeric-type
- (let ((lo (numeric-type-low type))
- (hi (numeric-type-high type)))
- (case (numeric-type-complexp type)
- (:real
- (case (numeric-type-class type)
- (integer
- (cond ((and hi lo)
- (dolist (spec
- `((positive-fixnum 0 ,sb!xc:most-positive-fixnum)
- ,@(ecase sb!vm::n-machine-word-bits
- (32
- `((unsigned-byte-31
- 0 ,(1- (ash 1 31)))
- (unsigned-byte-32
- 0 ,(1- (ash 1 32)))))
- (64
- `((unsigned-byte-63
- 0 ,(1- (ash 1 63)))
- (unsigned-byte-64
- 0 ,(1- (ash 1 64))))))
- (fixnum ,sb!xc:most-negative-fixnum
- ,sb!xc:most-positive-fixnum)
- ,(ecase sb!vm::n-machine-word-bits
- (32
- `(signed-byte-32 ,(ash -1 31)
- ,(1- (ash 1 31))))
- (64
- `(signed-byte-64 ,(ash -1 63)
- ,(1- (ash 1 63))))))
- (if (or (< hi sb!xc:most-negative-fixnum)
- (> lo sb!xc:most-positive-fixnum))
- (part-of bignum)
- (any)))
- (let ((type (car spec))
- (min (cadr spec))
- (max (caddr spec)))
- (when (<= min lo hi max)
- (return (values
- (primitive-type-or-lose type)
- (and (= lo min) (= hi max))))))))
- ((or (and hi (< hi sb!xc:most-negative-fixnum))
- (and lo (> lo sb!xc:most-positive-fixnum)))
- (part-of bignum))
- (t
- (any))))
- (float
- (let ((exact (and (null lo) (null hi))))
- (case (numeric-type-format type)
- ((short-float single-float)
- (values (primitive-type-or-lose 'single-float)
- exact))
- ((double-float)
- (values (primitive-type-or-lose 'double-float)
- exact))
- (t
- (any)))))
- (t
- (any))))
- (:complex
- (if (eq (numeric-type-class type) 'float)
- (let ((exact (and (null lo) (null hi))))
- (case (numeric-type-format type)
- ((short-float single-float)
- (values (primitive-type-or-lose 'complex-single-float)
- exact))
- ((double-float long-float)
- (values (primitive-type-or-lose 'complex-double-float)
- exact))
- (t
- (part-of complex))))
- (part-of complex)))
- (t
- (any)))))
- (array-type
- (if (array-type-complexp type)
- (any)
- (let* ((dims (array-type-dimensions type))
- (etype (array-type-specialized-element-type type))
- (type-spec (type-specifier etype))
- ;; FIXME: We're _WHAT_? Testing for type equality
- ;; with a specifier and #'EQUAL? *BOGGLE*. --
- ;; CSR, 2003-06-24
- (ptype (cdr (assoc type-spec *simple-array-primitive-types*
- :test #'equal))))
- (if (and (consp dims) (null (rest dims)) ptype)
- (values (primitive-type-or-lose ptype)
- (eq (first dims) '*))
- (any)))))
- (union-type
- (if (type= type (specifier-type 'list))
- (exactly list)
- (let ((types (union-type-types type)))
- (multiple-value-bind (res exact) (primitive-type (first types))
- (dolist (type (rest types) (values res exact))
- (multiple-value-bind (ptype ptype-exact)
- (primitive-type type)
- (unless ptype-exact (setq exact nil))
- (unless (eq ptype res)
- (let ((new-ptype
+ (numeric-type
+ (let ((lo (numeric-type-low type))
+ (hi (numeric-type-high type)))
+ (case (numeric-type-complexp type)
+ (:real
+ (case (numeric-type-class type)
+ (integer
+ (cond ((and hi lo)
+ (dolist (spec
+ `((positive-fixnum 0 ,sb!xc:most-positive-fixnum)
+ ,@(ecase sb!vm::n-machine-word-bits
+ (32
+ `((unsigned-byte-31
+ 0 ,(1- (ash 1 31)))
+ (unsigned-byte-32
+ 0 ,(1- (ash 1 32)))))
+ (64
+ `((unsigned-byte-63
+ 0 ,(1- (ash 1 63)))
+ (unsigned-byte-64
+ 0 ,(1- (ash 1 64))))))
+ (fixnum ,sb!xc:most-negative-fixnum
+ ,sb!xc:most-positive-fixnum)
+ ,(ecase sb!vm::n-machine-word-bits
+ (32
+ `(signed-byte-32 ,(ash -1 31)
+ ,(1- (ash 1 31))))
+ (64
+ `(signed-byte-64 ,(ash -1 63)
+ ,(1- (ash 1 63))))))
+ (if (or (< hi sb!xc:most-negative-fixnum)
+ (> lo sb!xc:most-positive-fixnum))
+ (part-of bignum)
+ (any)))
+ (let ((type (car spec))
+ (min (cadr spec))
+ (max (caddr spec)))
+ (when (<= min lo hi max)
+ (return (values
+ (primitive-type-or-lose type)
+ (and (= lo min) (= hi max))))))))
+ ((or (and hi (< hi sb!xc:most-negative-fixnum))
+ (and lo (> lo sb!xc:most-positive-fixnum)))
+ (part-of bignum))
+ (t
+ (any))))
+ (float
+ (let ((exact (and (null lo) (null hi))))
+ (case (numeric-type-format type)
+ ((short-float single-float)
+ (values (primitive-type-or-lose 'single-float)
+ exact))
+ ((double-float)
+ (values (primitive-type-or-lose 'double-float)
+ exact))
+ (t
+ (any)))))
+ (t
+ (any))))
+ (:complex
+ (if (eq (numeric-type-class type) 'float)
+ (let ((exact (and (null lo) (null hi))))
+ (case (numeric-type-format type)
+ ((short-float single-float)
+ (values (primitive-type-or-lose 'complex-single-float)
+ exact))
+ ((double-float long-float)
+ (values (primitive-type-or-lose 'complex-double-float)
+ exact))
+ (t
+ (part-of complex))))
+ (part-of complex)))
+ (t
+ (any)))))
+ (array-type
+ (if (array-type-complexp type)
+ (any)
+ (let* ((dims (array-type-dimensions type))
+ (etype (array-type-specialized-element-type type))
+ (type-spec (type-specifier etype))
+ ;; FIXME: We're _WHAT_? Testing for type equality
+ ;; with a specifier and #'EQUAL? *BOGGLE*. --
+ ;; CSR, 2003-06-24
+ (ptype (cdr (assoc type-spec *simple-array-primitive-types*
+ :test #'equal))))
+ (if (and (consp dims) (null (rest dims)) ptype)
+ (values (primitive-type-or-lose ptype)
+ (eq (first dims) '*))
+ (any)))))
+ (union-type
+ (if (type= type (specifier-type 'list))
+ (exactly list)
+ (let ((types (union-type-types type)))
+ (multiple-value-bind (res exact) (primitive-type (first types))
+ (dolist (type (rest types) (values res exact))
+ (multiple-value-bind (ptype ptype-exact)
+ (primitive-type type)
+ (unless ptype-exact (setq exact nil))
+ (unless (eq ptype res)
+ (let ((new-ptype