-(macrolet
- ((frob-opt (name q-name r-name)
- (let ((q-aux (symbolicate "F" q-name "-AUX"))
- (r-aux (symbolicate r-name "-AUX")))
- `(progn
- ;; Compute type of quotient (first) result.
- (defun ,q-aux (number-type divisor-type)
- (let* ((number-interval
- (numeric-type->interval number-type))
- (divisor-interval
- (numeric-type->interval divisor-type))
- (quot (,q-name (interval-div number-interval
- divisor-interval)))
- (res-type (numeric-contagion number-type divisor-type)))
- (make-numeric-type
- :class (numeric-type-class res-type)
- :format (numeric-type-format res-type)
- :low (interval-low quot)
- :high (interval-high quot))))
-
- (defoptimizer (,name derive-type) ((number divisor))
- (flet ((derive-q (n d same-arg)
- (declare (ignore same-arg))
- (if (and (numeric-type-real-p n)
- (numeric-type-real-p d))
- (,q-aux n d)
- *empty-type*))
- (derive-r (n d same-arg)
- (declare (ignore same-arg))
- (if (and (numeric-type-real-p n)
- (numeric-type-real-p d))
- (,r-aux n d)
- *empty-type*)))
- (let ((quot (two-arg-derive-type
- number divisor #'derive-q #',name))
- (rem (two-arg-derive-type
- number divisor #'derive-r #'mod)))
- (when (and quot rem)
- (make-values-type :required (list quot rem))))))))))
-
- ;; FIXME: DEF-FROB-OPT, not just FROB-OPT
- (frob-opt ffloor floor-quotient-bound floor-rem-bound)
- (frob-opt fceiling ceiling-quotient-bound ceiling-rem-bound))
+(macrolet ((def (name q-name r-name)
+ (let ((q-aux (symbolicate "F" q-name "-AUX"))
+ (r-aux (symbolicate r-name "-AUX")))
+ `(progn
+ ;; Compute type of quotient (first) result.
+ (defun ,q-aux (number-type divisor-type)
+ (let* ((number-interval
+ (numeric-type->interval number-type))
+ (divisor-interval
+ (numeric-type->interval divisor-type))
+ (quot (,q-name (interval-div number-interval
+ divisor-interval)))
+ (res-type (numeric-contagion number-type
+ divisor-type)))
+ (make-numeric-type
+ :class (numeric-type-class res-type)
+ :format (numeric-type-format res-type)
+ :low (interval-low quot)
+ :high (interval-high quot))))
+
+ (defoptimizer (,name derive-type) ((number divisor))
+ (flet ((derive-q (n d same-arg)
+ (declare (ignore same-arg))
+ (if (and (numeric-type-real-p n)
+ (numeric-type-real-p d))
+ (,q-aux n d)
+ *empty-type*))
+ (derive-r (n d same-arg)
+ (declare (ignore same-arg))
+ (if (and (numeric-type-real-p n)
+ (numeric-type-real-p d))
+ (,r-aux n d)
+ *empty-type*)))
+ (let ((quot (two-arg-derive-type
+ number divisor #'derive-q #',name))
+ (rem (two-arg-derive-type
+ number divisor #'derive-r #'mod)))
+ (when (and quot rem)
+ (make-values-type :required (list quot rem))))))))))
+
+ (def ffloor floor-quotient-bound floor-rem-bound)
+ (def fceiling ceiling-quotient-bound ceiling-rem-bound))