2.5.1 · Generic arithmetic operations

Raise for a shared method, then drop only when information survives.

Build an integer, rational, and complex tower with explicit raising, same-type addition, equality, projection, and conservative result simplification.

Guiding question

How can mixed arithmetic find a common type and later return to a simpler type without discarding information?

Assign an explicit rank to every type in a numeric tower
Raise lower values until both operands share a method
Keep same-type arithmetic separate from coercion policy
Project a result only when raising it again reproduces the original value
Preserve a complex value when a nonzero imaginary component would be lost

add first raises the lower-ranked operand until both values share a tag. same-type-add then performs only representation-specific arithmetic. Integers raise to rationals with denominator 1; rationals raise to complex values with a zero imaginary rational. The arithmetic methods do not decide which conversions are allowed.

drop attempts the reverse direction conservatively. A rational projects to an integer only when its denominator is 1. A complex value projects to its real component only when its imaginary component is exactly zero. The projected value is raised again and compared with the original before simplification continues, so a nonzero imaginary component cannot disappear.

SICP code3,793 of 1,048,576 UTF-8 bytes

(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))))

(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))))

Examples

Result—

Output: —
Value: —
Diagnostic: —

Execution trace0 / 0 events

Expected result

The program returns ((rational 7 2) (integer 1) (integer 5) (complex (rational 3 1) (rational 1 1))).

Trace focus

For each add call, record both initial ranks and every raise. Then enter exactly one same-type method. Follow project, raise, and generic-equal? during dropping; the zero-imaginary complex result reaches integer 5, while the final nonzero-imaginary result remains complex.

Try it yourself

Change the program and compare the result.

Add generic multiplication for the same three types and reuse the existing raising and dropping path. Test a rational product that becomes an integer and a complex product whose imaginary component remains nonzero.

Show hint

Keep conversion outside the same-type method. A complex product needs rational addition, subtraction, and multiplication for its two components.

Complete this lesson

0 of 20 lessons complete in this chapter0%