umber-tests cps) (flonum-test cps))
    (cond
     ((eqv? number-types &number)
      ;; Generic: no reduction.
      (with-cps cps #f))
     ((eqv? number-types &fixnum)
      (with-cps cps
        (build-term
          ($branch kf kt src 'fixnum? #f (arg)))))
     ((logtest type &fixnum)
      (with-cps cps
        (let$ ktest (heap-number-tests))
        (letk kheap ($kargs () ()
                      ($branch kf ktest src 'heap-object? #f (arg))))
        (build-term
          ($branch kheap kt src 'fixnum? #f (arg)))))
     (else
      (with-cps cps
        (let$ ktest (heap-number-tests))
        (build-term
          ($branch kf ktest src 'heap-object? #f (arg))))))))
(define-branch-reducer-aliases number? complex?)

(define-unary-branch-reducer (real? cps kf kt src arg type min max)
  (let ((real-types (logand type &real)))
    (when (or (zero? real-types) (eqv? type real-types))
      (error "should have folded!"))
    (define-syntax-rule (define-heap-number-test test &type pred next-test)
      (define (test cps)
        (if (logtest type &type)
            (with-cps cps
              (let$ kf (next-test))
              (letk k ($kargs () ()
                        ($branch kf kt src 'pred #f (arg))))
              k)
            (next-test cps))))
    (define (done cps) (with-cps cps kf))
    (define-heap-number-test fracnum-test &fraction fracnum? done)
    (define-heap-number-test bignum-test &bignum bignum? fracnum-test)
    (define-heap-number-test flonum-test &flonum flonum? bignum-test)
    (define (heap-number-tests cps) (flonum-test cps))
    (cond
     ((eqv? real-types &real)
      ;; Generic: no reduction.
      (with-cps cps #f))
     ((eqv? real-types &fixnum)
      (with-cps cps
        (build-term
          ($branch kf kt src 'fixnum? #f (arg)))))
     ((logtest type &fixnum)
      (with-cps cps
        (let$ ktest (heap-number-tests))
        (letk kheap ($kargs () ()
                      ($branch kf ktest src 'heap-object? #f (arg))))
        (build-term
          ($branch kheap kt src 'fixnum? #f (arg)))))
     (else
      (with-cps cps
        (let$ ktest (heap-number-tests))
        (build-term
          ($branch kf ktest src 'heap-object? #f (arg))))))))

(define-unary-branch-reducer (rational? cps kf kt src arg type min max)
  (let ((number-types (logand type &number)))
    (when (or (zero? number-types) (eqv? type (logand type &exact-number)))
      (error "should have folded!"))
    (define-syntax-rule (define-heap-number-test test &type pred next-test)
      (define (test cps)
        (if (logtest type &type)
            (with-cps cps
              (let$ kf (next-test))
              (letk k ($kargs () ()
                        ($branch kf kt src 'pred #f (arg))))
              k)
            (next-test cps))))
    (define (done cps) (with-cps cps kf))
    (define-heap-number-test fracnum-test &fraction fracnum? done)
    (define-heap-number-test bignum-test &bignum bignum? fracnum-test)
    (define (heap-number-tests cps) (bignum-test cps))
    (cond
     ((logtest type (logior &complex &flonum))
      ;; Too annoying to inline inf / nan tests.
      (with-cps cps #f))
     ((eqv? number-types &fixnum)
      (with-cps cps
        (build-term
          ($branch kf kt src 'fixnum? #f (arg)))))
     ((logtest type &fixnum)
      (with-cps cps
        (let$ ktest (heap-number-tests))
        (letk kheap ($kargs () ()
                      ($branch kf ktest src 'heap-object? #f (arg))))
        (build-term
          ($branch kheap kt src 'fixnum? #f (arg)))))
     (else
      (with-cps cps
        (let$ ktest (heap-number-tests))
        (build-term
          ($branch kf ktest src 'heap-object? #f (arg))))))))

(define-unary-branch-reducer (integer? cps kf kt src arg type min max)
  (define &integer-types (logior &fixnum &bignum &flonum &complex))
  (let ((integer-types (logand type &integer-types)))
    (when (or (zero? integer-types) (eqv? type (logand type &exact-integer)))
      (error "should have folded!"))
    (define-syntax-rule (define-heap-number-test test &type pred next-test)
      (define (test cps)
        (if (logtest type &type)
            (with-cps cps
              (let$ kf (next-test))
              (letk k ($kargs () ()
                        ($branch kf kt src 'pred #f (arg))))
              k)
            (next-test cps))))
    (define (done cps) (with-cps cps kf))
    (define-heap-number-test bignum-test &bignum bignum? done)
    (define (heap-number-tests cps) (bignum-test cps))
    (cond
     ((logtest type (logior &complex &flonum))
      ;; Too annoying to inline integer tests.
      (with-cps cps #f))
     ((eqv? integer-types &fixnum)
      (with-cps cps
        (build-term
          ($branch kf kt src 'fixnum? #f (arg)))))
     ((logtest type &fixnum)
      (with-cps cps
        (let$ ktest (heap-number-tests))
        (letk kheap ($kargs () ()
                      ($branch kf ktest src 'heap-object? #f (arg))))
        (build-term
          ($branch kheap kt src 'fixnum? #f (arg)))))
     (else
      (with-cps cps
        (let$ ktest (heap-number-tests))
        (build-term
          ($branch kf ktest src 'heap-object? #f (arg))))))))

(define-unary-branch-reducer (exact-integer? cps kf kt src arg type min max)
  (let ((integer-types (logand type &exact-integer)))
    (when (or (zero? integer-types) (eqv? type integer-types))
      (error "should have folded!"))
    (cond
     ((eqv? integer-types &fixnum)
      (with-cps cps
        (build-term
          ($branch kf kt src 'fixnum? #f (arg)))))
     ((eqv? integer-types &bignum)
      (with-cps cps
        (letk kbig? ($kargs () ()
                      ($branch kf kt src 'bignum? #f (arg))))
        (build-term
          ($branch kf kbig? src 'heap-object? #f (arg)))))
     (else
      ;; No reduction.
      (with-cps cps #f)))))

(define-unary-branch-reducer (exact? cps kf kt src arg type min max)
  (let ((exact-types (logand type &exact-number)))
    (when (or (zero? exact-types) (eqv? type exact-types))
      (error "should have folded!"))
    ;; We have already passed a number? check, so we can assume either
    ;; fixnum or heap number.
    (define-syntax-rule (define-number-test test &type pred next-test)
      (define (test cps)
        (if (logtest type &type)
            (with-cps cps
              (let$ kf (next-test))
              (letk k ($kargs () ()
                        ($branch kf kt src 'pred #f (arg))))
              k)
            (next-test cps))))
    (define (done cps) (with-cps cps kf))
    (define-number-test fracnum-test &fraction fracnum? done)
    (define-number-test bignum-test &bignum bignum? fracnum-test)
    (define-number-test fixnum-test &fixnum fixnum? bignum-test)
    (define (number-tests cps) (fixnum-test cps))
    (cond
     ((eqv? exact-types &exact-number)
      ;; Generic: no reduction.
      (with-cps cps #f))
     (else
      (with-cps cps
        (let$ ktest (number-tests))
        (build-term
          ($continue ktest #f ($values ()))))))))

(define-unary-branch-reducer (inexact? cps kf kt src arg type min max)
  (define &inexact-number (logior &flonum &complex))
  (let ((inexact-types (logand type &inexact-number)))
    (when (or (zero? inexact-types) (eqv? type inexact-types))
      (error "should have folded!"))
    ;; We have already passed a number? check, so we can assume either
    ;; fixnum or heap number.
    (cond
     ((eqv? (logand type &exact-number) &fixnum)
      (with-cps cps
        (build-term
          ($branch kt kf src 'fixnum? #f (arg)))))
     ((logtest type &fixnum)
      (cond
       ((eqv? inexact-types &flonum)
        (with-cps cps
          (letk kflo ($kargs () ()
                       ($branch kf kt src 'flonum? #f (arg))))
          (build-term
            ($branch kflo kf src 'fixnum? #f (arg)))))
       ((eqv? inexact-types &complex)
        (with-cps cps
          (letk kcomp ($kargs () ()
                        ($branch kf kt src 'compnum? #f (arg))))
          (build-term
            ($branch kcomp kf src 'fixnum? #f (arg)))))
       (else
        ;; Generic: no reduction.
        (with-cps cps #f))))
     ((eqv? inexact-types &flonum)
      (with-cps cps
        (build-term
          ($branch kf kt src 'flonum? #f (arg)))))
     ((eqv? inexact-types &complex)
      (with-cps cps
        (build-term
          ($branch kf kt src 'compnum? #f (arg)))))
     (else
      ;; Still specialize, as we avoid heap-object?.
      (with-cps cps
        (letk kcomp ($kargs () ()
                      ($branch kf kt src 'compnum? #f (arg))))
        (build-term
          ($branch kcomp kt src 'flonum? #f (arg))))))))

(define-binary-branch-reducer (eq? cps kf kt src
                                   arg0 type0 min0 max0
                                   arg1 type1 min1 max1)
  (materialize-constant
   type0 min0 max0
   (lambda (const)
     (with-cps cps
       (build-term
         ($branch kf kt src 'eq-constant? const (arg1)))))
   (lambda ()
     (materialize-constant
      type1 min1 max1
      (lambda (const)
        (with-cps cps
          (build-term
            ($branch kf kt src 'eq-constant? const (arg0)))))
      (lambda () (with-cps cps #f))))))