SICP по-русски

Определение операции проецирования project похоже на определение операции raise.

Мы также вводим обобщенную операцию:

(define (project x) (apply-generic 'project x))

и добавляем в пакеты соответствующие строки, реализующие для каждого типа в башне проецирование на предыдущий:

;integer package

;rational package
(define (rational->integer r)
  (make-integer (round (/ (numer r) (denom r)))))
(put 'project '(rational) rational->integer)

;real package
(define (real->rational x)
  (make-rational (numerator x) (denominator x)))
(put 'project '(real) real->rational)

; complex package
(define (complex->real z)
  (make-real (real-part z)))
(put 'project '(complex) complex->real)

Преобразование комплексного числа к действительному и рационального к целому особых трудностей не вызывает, а вот получить из действительного числа рациональное уже сложнее. Первоначально я хотел выбросить рациональные числа из башни и сделать упражение без них, но потом подглядел у Эли Бендерски, что в Scheme есть встроенные процедуры numerator и denominator, которые получают числитель и знаменатель по действительному числу. Это как раз то, что мне было нужно для получения рационального числа из действительного.

Операция drop записывается довольно просто. Мы смотрим, можно ли вообще спроецировать объект на тип ниже. Если нет, то спуск по башне окончен. Если да, то проверяем, эквивалентен ли исходный объект поднятой проекции. Если нет, то опять же спуск окончен. Если же эквивалентность выполняется, то мы повторяем тот же процесс спуска на ступеньку для проекции. Выглядит это так:

(define (drop x)
  (let ((op (get 'project (type-tag x))))
    (if op
        (let ((p (project x)))
          (if (equ? x (raise p))
              (drop p)
              x))
        x)))

Для того, чтобы внедрить упрощение результатов операций с помощью drop в apply-generic достаточно просто обернуть в drop результат вызова apply. Соответствующая строчка будет иметь вид:

(drop (apply proc (map contents args)))

Больше никаких изменений apply-generic не требует.