- (when (and (eq class1 class2)
- (eq format1 format2)
- (eq complexp1 complexp2)
- (or (numeric-types-intersect type1 type2)
- (numeric-types-adjacent type1 type2)
- (numeric-types-adjacent type2 type1)))
- (make-numeric-type
- :class class1
- :format format1
- :complexp complexp1
- :low (numeric-bound-max (numeric-type-low type1)
- (numeric-type-low type2)
- <= < t)
- :high (numeric-bound-max (numeric-type-high type1)
- (numeric-type-high type2)
- >= > t)))))))
+ (cond
+ ((and (eq class1 class2)
+ (eq format1 format2)
+ (eq complexp1 complexp2)
+ (or (numeric-types-intersect type1 type2)
+ (numeric-types-adjacent type1 type2)
+ (numeric-types-adjacent type2 type1)))
+ (make-numeric-type
+ :class class1
+ :format format1
+ :complexp complexp1
+ :low (numeric-bound-max (numeric-type-low type1)
+ (numeric-type-low type2)
+ <= < t)
+ :high (numeric-bound-max (numeric-type-high type1)
+ (numeric-type-high type2)
+ >= > t)))
+ ;; FIXME: These two clauses are almost identical, and the
+ ;; consequents are in fact identical in every respect.
+ ((and (eq class1 'rational)
+ (eq class2 'integer)
+ (eq format1 format2)
+ (eq complexp1 complexp2)
+ (integerp (numeric-type-low type2))
+ (integerp (numeric-type-high type2))
+ (= (numeric-type-low type2) (numeric-type-high type2))
+ (or (numeric-types-adjacent type1 type2)
+ (numeric-types-adjacent type2 type1)))
+ (make-numeric-type
+ :class 'rational
+ :format format1
+ :complexp complexp1
+ :low (numeric-bound-max (numeric-type-low type1)
+ (numeric-type-low type2)
+ <= < t)
+ :high (numeric-bound-max (numeric-type-high type1)
+ (numeric-type-high type2)
+ >= > t)))
+ ((and (eq class1 'integer)
+ (eq class2 'rational)
+ (eq format1 format2)
+ (eq complexp1 complexp2)
+ (integerp (numeric-type-low type1))
+ (integerp (numeric-type-high type1))
+ (= (numeric-type-low type1) (numeric-type-high type1))
+ (or (numeric-types-adjacent type1 type2)
+ (numeric-types-adjacent type2 type1)))
+ (make-numeric-type
+ :class 'rational
+ :format format1
+ :complexp complexp1
+ :low (numeric-bound-max (numeric-type-low type1)
+ (numeric-type-low type2)
+ <= < t)
+ :high (numeric-bound-max (numeric-type-high type1)
+ (numeric-type-high type2)
+ >= > t)))
+ (t nil))))))
+