2.4.3 · Программирование, управляемое данными, и аддитивность

Установка пакета в таблицу вместо правки вызовов

Установите конструкторы и селекторы конкретных представлений по ключам операции и типа, а затем добавьте новый пакет без изменения обобщенного диспетчера.

Вопрос для размышления

Как обобщенная система может получить еще одно представление или операцию без изменения единого центрального условного выражения?

Сохранение процедур под явными ключами операции и типа
Разделение установки пакета и последующего обобщенного применения
Передача методам конкретного представления только содержимого без тегов
Добавление второго представления без изменения apply-generic
Наблюдение аддитивности в виде роста таблицы при неизменном клиентском коде

Каждая процедура установки управляет деталями одного представления и регистрирует четыре метода. apply-generic умеет только считывать тег типа, извлекать метод и передавать ему содержимое. Содержимое rectangular хранит x перед y, а содержимое swapped хранит y перед x. Оба пакета удовлетворяют одному и тому же протоколу для real-part, imag-part, magnitude-squared и конструкторов.

Вторая программа начинается только с метода описания для integer. Рациональное значение rational сначала приводит к no-method. Установка еще одной записи в таблицу позволяет тому же диспетчеру describe принять это значение без изменения диспетчера или пакета integer. Аддитивность здесь явная и конечная: расширение происходит путем регистрации еще одного метода под новым ключом.

Код SICP2,221 из 1,048,576 байт UTF-8

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

Примеры

Результат—

Вывод: —
Значение: —
Диагностика: —

Трасса выполнения0 / 0 событий

Ожидаемый результат

Программа с пакетами возвращает (4 8 rectangular swapped 3 4 25 3 4 25). Программа аддитивного расширения возвращает ((integer 7) no-method (fraction 3 2) 2).

На что обратить внимание в трассе

Отделите вызовы put на этапе установки от последующих get и вызовов методов. Убедитесь, что apply-generic остается без изменений при установке пакета swapped. Во второй программе сравните поиск для rational до и после появления новой записи в таблице.

Попробуйте сами

Измените программу и сравните результат.

Добавьте представление translated, содержимое которого хранит x плюс 10 и y плюс 10. Установите селекторы, вычитающие смещение, и убедитесь, что существующий обобщенный клиент по-прежнему наблюдает 3, 4 и 25.

Показать подсказку

Оставьте смещение полностью внутри нового конструктора и методов, не добавляя ветвление по типу в apply-generic.

Завершить этот урок

В этой главе пройдено 0 из 20 уроков0%