- (flet ((ill-type ()
- (error "Invalid type specifier: ~s" type)))
- (macrolet ((with-parameters ((arg-type &key (min-length 0))
- (&rest args) &body body)
- (let ((type-sym (gensym)))
- `(let (,@(loop for arg in args
- collect `(,arg '*)))
- (declare (ignorable ,@args))
- (when ,(if (plusp min-length)
- t
- '(consp type))
- (let ((,type-sym (cdr type)))
- (unless (proper-list-of-length-p ,type-sym ,min-length ,(length args))
- (ill-type))
- (block nil
- ,@(loop for arg in args
- for i from 0
- collect
- `(if ,type-sym
- (let ((value (pop ,type-sym)))
- (if (or ,(if (>= i min-length)
- `(eq value '*))
- (typep value ',arg-type))
- (setf ,arg value)
- (ill-type)))
- (return))))))
- ,@body)))
- (result (widetag)
- (let ((value (symbol-value widetag)))
- `(values ,value
- ,(sb!vm:saetp-n-bits
- (find value
- sb!vm:*specialized-array-element-type-properties*
- :key #'sb!vm:saetp-typecode))))))
+ (macrolet ((with-parameters ((arg-type &key intervals)
+ (&rest args) &body body)
+ (let ((type-sym (gensym)))
+ `(let (,@(loop for arg in args
+ collect `(,arg '*)))
+ (declare (ignorable ,@args))
+ (when (consp type)
+ (let ((,type-sym (cdr type)))
+ (block nil
+ ,@(loop for arg in args
+ collect
+ `(cond ((consp ,type-sym)
+ (let ((value (pop ,type-sym)))
+ (if (or (eq value '*)
+ (typep value ',arg-type)
+ ,(if intervals
+ `(and (consp value)
+ (null (cdr value))
+ (typep (car value)
+ ',arg-type))))
+ (setf ,arg value)
+ (ill-type))))
+ ((null ,type-sym)
+ (return))
+ (t
+ (ill-type)))))
+ (when ,type-sym
+ (ill-type))))
+ ,@body)))
+ (result (widetag)
+ (let ((value (symbol-value widetag)))
+ `(values ,value
+ ,(sb!vm:saetp-n-bits
+ (find value
+ sb!vm:*specialized-array-element-type-properties*
+ :key #'sb!vm:saetp-typecode))))))
+ (flet ((ill-type ()
+ (error "Invalid type specifier: ~s" type))
+ (integer-interval-widetag (low high)
+ (if (minusp low)
+ (%integer-vector-widetag-and-n-bits
+ t
+ (1+ (max (integer-length low) (integer-length high))))
+ (%integer-vector-widetag-and-n-bits
+ nil
+ (max (integer-length low) (integer-length high))))))