공통 메서드를 찾기 위해 올리고 정보가 보존될 때만 내린다.

(begin
  (define (absolute value)
    (if (< value 0) (- value) value))
  (define (greatest-common-divisor a b)
    (if (= b 0)
        a
        (greatest-common-divisor b (remainder a b))))
  (define (make-integer value)
    (list 'integer value))
  (define (make-rational numerator denominator)
    (let* ((signed-numerator
             (if (< denominator 0) (- numerator) numerator))
           (positive-denominator (absolute denominator))
           (divisor
             (greatest-common-divisor
               (absolute signed-numerator)
               positive-denominator)))
      (list 'rational
            (/ signed-numerator divisor)
            (/ positive-denominator divisor))))
  (define (make-complex real-part imaginary-part)
    (list 'complex real-part imaginary-part))
  (define (type-tag value) (car value))
  (define (rank value)
    (cond ((eq? (type-tag value) 'integer) 0)
          ((eq? (type-tag value) 'rational) 1)
          ((eq? (type-tag value) 'complex) 2)
          (else -1)))
  (define (raise value)
    (cond ((eq? (type-tag value) 'integer)
           (make-rational (cadr value) 1))
          ((eq? (type-tag value) 'rational)
           (make-complex value (make-rational 0 1)))
          (else #f)))
  (define (raise-to value target-rank)
    (if (= (rank value) target-rank)
        value
        (raise-to (raise value) target-rank)))
  (define (add-rational left right)
    (make-rational
      (+ (* (cadr left) (caddr right))
         (* (cadr right) (caddr left)))
      (* (caddr left) (caddr right))))
  (define (same-type-add left right)
    (cond ((eq? (type-tag left) 'integer)
           (make-integer (+ (cadr left) (cadr right))))
          ((eq? (type-tag left) 'rational)
           (add-rational left right))
          ((eq? (type-tag left) 'complex)
           (make-complex
             (add-rational (cadr left) (cadr right))
             (add-rational (caddr left) (caddr right))))
          (else 'unsupported-type)))
  (define (generic-equal? left right)
    (and (eq? (type-tag left) (type-tag right))
         (cond ((eq? (type-tag left) 'integer)
                (= (cadr left) (cadr right)))
               ((eq? (type-tag left) 'rational)
                (and (= (cadr left) (cadr right))
                     (= (caddr left) (caddr right))))
               ((eq? (type-tag left) 'complex)
                (and (generic-equal? (cadr left) (cadr right))
                     (generic-equal? (caddr left) (caddr right))))
               (else #f))))
  (define (project value)
    (cond ((and (eq? (type-tag value) 'rational)
                (= (caddr value) 1))
           (make-integer (cadr value)))
          ((and (eq? (type-tag value) 'complex)
                (generic-equal?
                  (caddr value)
                  (make-rational 0 1)))
           (cadr value))
          (else #f)))
  (define (drop value)
    (let ((lower (project value)))
      (if lower
          (let ((raised (raise lower)))
            (if (and raised (generic-equal? raised value))
                (drop lower)
                value))
          value)))
  (define (add left right)
    (let* ((target-rank
             (if (> (rank left) (rank right))
                 (rank left)
                 (rank right)))
           (raised-left (raise-to left target-rank))
           (raised-right (raise-to right target-rank)))
      (drop (same-type-add raised-left raised-right))))
  (list
    (add (make-integer 2)
         (make-rational 3 2))
    (add (make-rational 1 2)
         (make-rational 1 2))
    (add (make-complex
           (make-rational 2 1)
           (make-rational 0 1))
         (make-integer 3))
    (add (make-complex
           (make-rational 1 1)
           (make-rational 1 1))
         (make-rational 2 1))))