SICP 全笔记

Exercise 2.84. Using the raise operation of exercise 2.83, modify the apply-generic procedure so that it coerces its arguments to have the same type by the method of successive raising, as discussed in this section. You will need to devise a way to test which of two types is higher in the tower. Do this in a manner that is ‘‘compatible’’ with the rest of the system and will not lead to problems in adding new levels to the tower.

raise

raise 的解析可以见练习 2.83的解析。

(define (raise x)
  (let ((f (get 'raise (type-tag x))))
    (if f
        (f (contents x))
        (error "RAISE ERROR" x))))

(define (successive-raise type-datum top-type)
  (if (eq? (type-tag type-datum) top-type)
      type-datum
      (successive-raise (raise type-datum) top-type)))

(define tower '(scheme-number rational complex))

寻找最上层的类型

有各种不同的方法来寻找最上层的类型，这里，我使用了 member 过程来求出某个类型及其上层类型：

(member 'rational '(scheme-number rational complex))
;=> (rational complex)

有了这个过程，我们可以如下写

(define (the-most-top-type type-tags)
  (define (uppers tags upper-tower)
    (cond ((null? tags) (car upper-tower))
          (else
           (let ((maybe-uppers (member (car tags) upper-tower)))
             (if maybe-uppers
                 (uppers (cdr tags) maybe-uppers)
                 (uppers (cdr tags) upper-tower))))))
  (uppers type-tags tower))

apply-generic

我们不需要修改 apply-generic 的只有一种参数的情况。当参数个数大于 2 的时候，我们才需要去使用我们的新方法：

(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op type-tags)))
      (if proc
          (apply proc (map contents args))
          (if (>= (length args) 2)
              (let* ((type-tags (map type-tag args))
                     (top-type (the-most-top-type type-tags))
                     (coerced-args (map (lambda (x)
                                          (successive-raise x top-type))
                                        args))
                     (new-type-tags (map type-tag coerced-args)))
                (let ((proc (get op new-type-tags)))
                  (if proc
                      (apply proc (map contents coerced-args))
                      (error "No method for these types"
                             (list op type-tags)))))
              (error "No method for these types -- APPLY-GENERIC"
                     (list op type-tags)))))))

测试

这里测试的目的是看我们的 apply-generic 是否能把某种类型正确地转换为其父类型然后进行算数运算。


(load "../testframe.scm")

(assert= (add 3 3) 6)
(assertequal? (add 3 (make-rational 1 4))
              (make-rational 13 4))
(assertequal? (add 3 (make-complex-from-real-imag 3 5))
              (make-complex-from-real-imag 6 5))

(assertequal? (add (make-rational 2 5)
                   (make-rational 1 5))
              (make-rational 3 5))

(assertequal? (add (make-complex-from-real-imag 3 8)
                   (make-complex-from-real-imag 5 6))
              (make-complex-from-real-imag 8 14))