+ (complexp :real :type (member :real :complex nil) :read-only t)
+ ;; The upper and lower bounds on the value, or NIL if there is no
+ ;; bound. If a list of a number, the bound is exclusive. Integer
+ ;; types never have exclusive bounds, i.e. they may have them on
+ ;; input, but they're canonicalized to inclusive bounds before we
+ ;; store them here.
+ (low nil :type (or number cons null) :read-only t)
+ (high nil :type (or number cons null) :read-only t))
+
+;;; Impose canonicalization rules for NUMERIC-TYPE. Note that in some
+;;; cases, despite the name, we return *EMPTY-TYPE* instead of a
+;;; NUMERIC-TYPE.
+(defun make-numeric-type (&key class format (complexp :real) low high
+ enumerable)
+ ;; if interval is empty
+ (if (and low
+ high
+ (if (or (consp low) (consp high)) ; if either bound is exclusive
+ (>= (type-bound-number low) (type-bound-number high))
+ (> low high)))
+ *empty-type*
+ (multiple-value-bind (canonical-low canonical-high)
+ (case class
+ (integer
+ ;; INTEGER types always have their LOW and HIGH bounds
+ ;; represented as inclusive, not exclusive values.
+ (values (if (consp low)
+ (1+ (type-bound-number low))
+ low)
+ (if (consp high)
+ (1- (type-bound-number high))
+ high)))
+ (t
+ ;; no canonicalization necessary
+ (values low high)))
+ (when (and (eq class 'rational)
+ (integerp canonical-low)
+ (integerp canonical-high)
+ (= canonical-low canonical-high))
+ (setf class 'integer))
+ (%make-numeric-type :class class
+ :format format
+ :complexp complexp
+ :low canonical-low
+ :high canonical-high
+ :enumerable enumerable))))
+
+(defun modified-numeric-type (base
+ &key
+ (class (numeric-type-class base))
+ (format (numeric-type-format base))
+ (complexp (numeric-type-complexp base))
+ (low (numeric-type-low base))
+ (high (numeric-type-high base))
+ (enumerable (numeric-type-enumerable base)))
+ (make-numeric-type :class class
+ :format format
+ :complexp complexp
+ :low low
+ :high high
+ :enumerable enumerable))
+
+(defstruct (character-set-type
+ (:include ctype
+ (class-info (type-class-or-lose 'character-set)))
+ (:constructor %make-character-set-type)
+ (:copier nil))
+ (pairs (missing-arg) :type list :read-only t))
+(defun make-character-set-type (&key pairs)
+ (aver (equal (mapcar #'car pairs)
+ (sort (mapcar #'car pairs) #'<)))
+ (let ((pairs (let (result)
+ (do ((pairs pairs (cdr pairs)))
+ ((null pairs) (nreverse result))
+ (destructuring-bind (low . high) (car pairs)
+ (loop for (low1 . high1) in (cdr pairs)
+ if (<= low1 (1+ high))
+ do (progn (setf high (max high high1))
+ (setf pairs (cdr pairs)))
+ else do (return nil))
+ (cond
+ ((>= low sb!xc:char-code-limit))
+ ((< high 0))
+ (t (push (cons (max 0 low)
+ (min high (1- sb!xc:char-code-limit)))
+ result))))))))
+ (if (null pairs)
+ *empty-type*
+ (%make-character-set-type :pairs pairs))))
+
+;;; An ARRAY-TYPE is used to represent any array type, including
+;;; things such as SIMPLE-BASE-STRING.