+ ;; 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)))
+ #!+negative-zero-is-not-zero
+ (float
+ ;; Canonicalize a low bound of (-0.0) to 0.0, and a high
+ ;; bound of (+0.0) to -0.0.
+ (values (if (and (consp low)
+ (floatp (car low))
+ (zerop (car low))
+ (minusp (float-sign (car low))))
+ (float 0.0 (car low))
+ low)
+ (if (and (consp high)
+ (floatp (car high))
+ (zerop (car high))
+ (plusp (float-sign (car high))))
+ (float -0.0 (car high))
+ high)))
+ (t
+ ;; no canonicalization necessary
+ (values low high)))
+ (%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))