2.4.3 · Data-directed programming and additivity

A package extends the table instead of editing every caller.

Install representation-specific constructors and selectors under operation and type keys, then add a new package without changing the generic dispatcher.

Guiding question

How can a generic system gain another representation or operation without reopening one central conditional?

Store procedures under explicit operation and type keys
Separate package installation from later generic application
Give representation-specific methods only untagged contents
Add a second representation without changing apply-generic
Observe additivity as table growth with stable client code

Each installer owns the details of one representation and registers four methods. apply-generic knows only how to read a type tag, retrieve a method, and pass it the contents. Rectangular contents store x before y; swapped contents store y before x. Both packages satisfy the same real-part, imag-part, magnitude-squared, and constructor protocol.

The second program begins with only an integer description method. A rational value initially produces no-method. Installing one more table entry makes the same describe dispatcher accept it without editing the dispatcher or the integer package. Additivity here is explicit and finite: extension occurs by registering another method under a new key.

SICP code2,221 of 1,048,576 UTF-8 bytes

(begin
  (define operation-table '())
  (define (put operation type procedure)
    (set! operation-table
          (cons (list operation type procedure)
                operation-table))
    'ok)
  (define (get operation type)
    (define (scan records)
      (cond ((null? records) #f)
            ((and (eq? operation (car (car records)))
                  (eq? type (cadr (car records))))
             (caddr (car records)))
            (else (scan (cdr records)))))
    (scan operation-table))
  (define (attach-tag type contents) (cons type contents))
  (define (type-tag datum) (car datum))
  (define (contents datum) (cdr datum))
  (define (apply-generic operation datum)
    (let ((method (get operation (type-tag datum))))
      (if method
          (method (contents datum))
          'no-method)))
  (define (make-from-real-imag type x y)
    ((get 'make-from-real-imag type) x y))
  (define (install-rectangular-package)
    (put 'real-part 'rectangular car)
    (put 'imag-part 'rectangular cdr)
    (put 'magnitude-squared 'rectangular
      (lambda (z)
        (+ (* (car z) (car z))
           (* (cdr z) (cdr z)))))
    (put 'make-from-real-imag 'rectangular
      (lambda (x y)
        (attach-tag 'rectangular (cons x y))))
    'done)
  (define (install-swapped-package)
    (put 'real-part 'swapped cdr)
    (put 'imag-part 'swapped car)
    (put 'magnitude-squared 'swapped
      (lambda (z)
        (+ (* (cdr z) (cdr z))
           (* (car z) (car z)))))
    (put 'make-from-real-imag 'swapped
      (lambda (x y)
        (attach-tag 'swapped (cons y x))))
    'done)
  (install-rectangular-package)
  (define first-count (length operation-table))
  (install-swapped-package)
  (define rectangular
    (make-from-real-imag 'rectangular 3 4))
  (define swapped
    (make-from-real-imag 'swapped 3 4))
  (list first-count
        (length operation-table)
        (type-tag rectangular)
        (type-tag swapped)
        (apply-generic 'real-part rectangular)
        (apply-generic 'imag-part rectangular)
        (apply-generic 'magnitude-squared rectangular)
        (apply-generic 'real-part swapped)
        (apply-generic 'imag-part swapped)
        (apply-generic 'magnitude-squared swapped)))

(begin
  (define operation-table '())
  (define (put operation type procedure)
    (set! operation-table
          (cons (list operation type procedure)
                operation-table))
    'ok)
  (define (get operation type)
    (define (scan records)
      (cond ((null? records) #f)
            ((and (eq? operation (car (car records)))
                  (eq? type (cadr (car records))))
             (caddr (car records)))
            (else (scan (cdr records)))))
    (scan operation-table))
  (define (attach-tag type contents) (cons type contents))
  (define (type-tag datum) (car datum))
  (define (contents datum) (cdr datum))
  (define (apply-generic operation datum)
    (let ((method (get operation (type-tag datum))))
      (if method
          (method (contents datum))
          'no-method)))
  (define (make-from-real-imag type x y)
    ((get 'make-from-real-imag type) x y))
  (define (install-rectangular-package)
    (put 'real-part 'rectangular car)
    (put 'imag-part 'rectangular cdr)
    (put 'magnitude-squared 'rectangular
      (lambda (z)
        (+ (* (car z) (car z))
           (* (cdr z) (cdr z)))))
    (put 'make-from-real-imag 'rectangular
      (lambda (x y)
        (attach-tag 'rectangular (cons x y))))
    'done)
  (define (install-swapped-package)
    (put 'real-part 'swapped cdr)
    (put 'imag-part 'swapped car)
    (put 'magnitude-squared 'swapped
      (lambda (z)
        (+ (* (cdr z) (cdr z))
           (* (car z) (car z)))))
    (put 'make-from-real-imag 'swapped
      (lambda (x y)
        (attach-tag 'swapped (cons y x))))
    'done)
  (install-rectangular-package)
  (define first-count (length operation-table))
  (install-swapped-package)
  (define rectangular
    (make-from-real-imag 'rectangular 3 4))
  (define swapped
    (make-from-real-imag 'swapped 3 4))
  (list first-count
        (length operation-table)
        (type-tag rectangular)
        (type-tag swapped)
        (apply-generic 'real-part rectangular)
        (apply-generic 'imag-part rectangular)
        (apply-generic 'magnitude-squared rectangular)
        (apply-generic 'real-part swapped)
        (apply-generic 'imag-part swapped)
        (apply-generic 'magnitude-squared swapped)))

Examples

Result—

Output: —
Value: —
Diagnostic: —

Execution trace0 / 0 events

Expected result

The package program returns (4 8 rectangular swapped 3 4 25 3 4 25). The additive extension program returns ((integer 7) no-method (fraction 3 2) 2).

Trace focus

Separate installation-time put calls from later get and method applications. Confirm that apply-generic is unchanged when swapped is installed. In the second program, compare the rational lookup before and after one new table entry appears.

Try it yourself

Change the program and compare the result.

Add a translated representation whose contents store x plus 10 and y plus 10. Install selectors that subtract the translation and confirm the existing generic client still observes 3, 4, and 25.

Show hint

Keep the translation entirely inside the new constructor and methods; do not add a type branch to apply-generic.

Complete this lesson

0 of 20 lessons complete in this chapter0%