                         arg0 type0 min0 max0
                                     arg1 type1 min1 max1)
  (cond
   ((not (type<=? (logior type0 type1) &exact-integer))
    (with-cps cps #f))
   ((and (eqv? type1 &fixnum) (eqv? min1 max1) (power-of-two? min1))
    (with-cps cps
      (build-term
        ($continue k src
          ($primcall 'rsh/immediate (logcount (1- min1)) (arg0))))))
   (else
    (with-cps cps #f))))

(define-binary-primcall-reducer (rem cps k src param
                                     arg0 type0 min0 max0
                                     arg1 type1 min1 max1)
  (cond
   ((not (type<=? (logior type0 type1) &exact-integer))
    (with-cps cps #f))
   ((and (eqv? type1 &fixnum) (eqv? min1 max1) (power-of-two? min1)
         (<= 0 min0))
    (with-cps cps
      (build-term
        ($continue k src
          ($primcall 'logand/immediate (1- min1) (arg0))))))
   (else
    (with-cps cps #f))))

(define-binary-primcall-reducer (mod cps k src param
                                     arg0 type0 min0 max0
                                     arg1 type1 min1 max1)
  (cond
   ((not (type<=? (logior type0 type1) &exact-integer))
    (with-cps cps #f))
   ((and (eqv? type1 &fixnum) (eqv? min1 max1) (power-of-two? min1))
    (with-cps cps
      (build-term
        ($continue k src
          ($primcall 'logand/immediate (1- min1) (arg0))))))
   (else
    (with-cps cps #f))))

(define-unary-primcall-reducer (mul/immediate cps k src constant
                                              arg type min max)
  (cond
   ((not (type<=? type &number))
    (with-cps cps #f))
   ((eqv? constant -1)
    ;; (* arg -1) -> (- 0 arg)
    (with-cps cps
      ($ (with-cps-constants ((zero 0))
           (build-term
             ($continue k src ($primcall 'sub #f (zero arg))))))))
   ((and (eqv? constant 0) (type<=? type &exact-number))
    ;; (* arg 0) -> 0 if arg is exact
    (with-cps cps
      (build-term ($continue k src ($const 0)))))
   ((eqv? constant 1)
    ;; (* arg 1) -> arg
    (with-cps cps
      (build-term ($continue k src ($values (arg))))))
   ((eqv? constant 2)
    ;; (* arg 2) -> (+ arg arg)
    (with-cps cps
      (build-term ($continue k src ($primcall 'add #f (arg arg))))))
   ((and (type<=? type &exact-integer)
         (positive? constant)
         (zero? (logand constant (1- constant))))
    ;; (* arg power-of-2) -> (lsh arg (log2 power-of-2))
    (let ((n (let lp ((bits 0) (constant constant))
               (if (= constant 1) bits (lp (1+ bits) (ash constant -1))))))
      (with-cps cps
        (build-term ($continue k src ($primcall 'lsh/immediate n (arg)))))))
   (else
    (with-cps cps #f))))

(define-binary-primcall-reducer (logbit? cps k src param
                                         arg0 type0 min0 max0
                                         arg1 type1 min1 max1)
  (define (compute-mask cps kmask src)
    (if (eq? min0 max0)
        (with-cps cps
          (build-term
            ($continue kmask src ($const (ash 1 min0)))))
        (with-cps cps
          ($ (with-cps-constants ((one 1))
               (letv n)
               (letk kn ($kargs ('n) (n)
                          ($continue kmask src
                            ($primcall 'lsh #f (one n)))))
               (build-term
                 ($continue kn src ($primcall 'untag-fixnum #f (arg0)))))))))
  (cond
   ((and (type<=? type0 &exact-integer)
         (<= 0 min0 (target-most-positive-fixnum))
         (<= 0 max0 (target-most-positive-fixnum)))
    (with-cps cps
      (letv mask res u64)
      (letk kt ($kargs () () ($continue k src ($const #t))))
      (letk kf ($kargs () () ($continue k src ($const #f))))
      (letk ku64 ($kargs (#f) (u64)
                   ($branch kt kf src 's64-imm-= 0 (u64))))
      (letk kand ($kargs (#f) (res)
                   ($continue ku64 src ($primcall 'untag-fixnum #f (res)))))
      (letk kmask ($kargs (#f) (mask)
                    ($continue kand src
                      ($primcall 'logand #f (mask arg1)))))
      ($ (compute-mask kmask src))))
   (else
    (with-cps cps #f))))

(define-binary-primcall-reducer (logior cps k src param
                                        arg0 type0 min0 max0
                                        arg1 type1 min1 max1)
  (cond
   ((type<=? (logior type0 type1) &exact-integer)
    (cond
     ((= 0 min0 max0)
      (with-cps cps
        (build-term
          ($continue k src ($values (arg1))))))
     ((= 0 min1 max1)
      (with-cps cps
        (build-term
          ($continue k src ($values (arg0))))))
     (else
      (with-cps cps #f))))
   (else
    (with-cps cps #f))))

(define-unary-primcall-reducer (u64->scm cps k src constant arg type min max)
  (cond
   ((<= max (target-most-positive-fixnum))
    (with-cps cps
      (letv s64)
      (letk ks64 ($kargs ('s64) (s64)
                   ($continue k src
                     ($primcall 'tag-fixnum #f (s64)))))
      (build-term
        ($continue ks64 src
          ($primcall 'u64->s64 #f (arg))))))
   (else
    (with-cps cps #f))))

(define-unary-primcall-reducer (s64->scm cps k src constant arg type min max)
  (cond
   ((<= (target-most-negative-fixnum) min max (target-most-positive-fixnum))
    (with-cps cps
      (build-term
        ($continue k src
          ($primcall 'tag-fixnum #f (arg))))))
   (else
    (with-cps cps #f))))

(define-unary-primcall-reducer (scm->s64 cps k src constant arg type min max)
  (cond
   ((and (type<=? type &exact-integer)
         (<= (target-most-negative-fixnum) min max (target-most-positive-fixnum)))
    (with-cps cps
      (build-term
        ($continue k src
          ($primcall 'untag-fixnum #f (arg))))))
   (else
    (with-cps cps #f))))

(define-unary-primcall-reducer (scm->u64 cps k src constant arg type min max)
  (cond
   ((and (type<=? type &exact-integer)
         (<= 0 min max (target-most-positive-fixnum)))
    (with-cps cps
      (letv s64)
      (letk ks64 ($kargs ('s64) (s64)
                   ($continue k src
                     ($primcall 's64->u64 #f (s64)))))
      (build-term
        ($continue ks64 src
          ($primcall 'untag-fixnum #f (arg))))))
   (else
    (with-cps cps #f))))

(define-unary-primcall-reducer (scm->f64 cps k src constant arg type min max)
  (cond
   ((and (type<=? type &exact-integer)
         (<= (target-most-negative-fixnum) min max (target-most-positive-fixnum)))
    (with-cps cps
      (letv s64)
      (letk ks64 ($kargs ('s64) (s64)
                   ($continue k src
                     ($primcall 's64->f64 #f (s64)))))
      (build-term
        ($continue ks64 src
          ($primcall 'untag-fixnum #f (arg))))))
   (else
    (with-cps cps #f))))

(define-unary-primcall-reducer (inexact cps k src constant arg type min max)
  (cond
   ((and (type<=? type &exact-integer)
         (<= (target-most-negative-fixnum) min max (target-most-positive-fixnum)))
    (with-cps cps
      (letv s64 f64)
      (letk kf64 ($kargs ('f64) (f64)
                   ($continue k src
                     ($primcall 'f64->scm #f (f64)))))
      (letk ks64 ($kargs ('s64) (s64)
                   ($continue kf64 src
                     ($primcall 's64->f64 #f (s64)))))
      (build-term
        ($continue ks64 src
          ($primcall 'untag-fixnum #f (arg))))))
   ((type<=? type &flonum)
    (with-cps cps
      (build-term
        ($continue k src ($primcall 'values #f (arg))))))
   (else
    (with-cps cps #f))))

