SICP

Exercise 2.81. Louis Reasoner has noticed that apply-generic may try to coerce the arguments to each other’s type even if they already have the same type. Therefore, he reasons, we need to put procedures in the coercion table to “coerce” arguments of each type to their own type. For example, in addition to the scheme-number->complex coercion shown above, he would do:

(define (scheme-number->scheme-number n) n)
(define (complex->complex z) z)
(put-coercion 'scheme-number 'scheme-number
              scheme-number->scheme-number)
(put-coercion 'complex 'complex complex->complex)

a. With Louis’s coercion procedures installed, what happens if apply-generic is called with two arguments of type scheme-number or two arguments of type complex for an operation that is not found in the table for those types? For example, assume that we’ve defined a generic exponentiation operation:

(define (exp x y) (apply-generic 'exp x y))

and have put a procedure for exponentiation in the Scheme-number package but not in any other package:

;; following added to Scheme-number package
(put 'exp '(scheme-number scheme-number)
     (lambda (x y) (tag (expt x y)))) ; using primitive expt

What happens if we call exp with two complex numbers as arguments?

b. Is Louis correct that something had to be done about coercion with arguments of the same type, or does apply-generic work correctly as is?

c. Modify apply-generic so that it doesn’t try coercion if the two arguments have the same type.

如果我们定义了一个自己类型到自己类型的转换，我们将可能在运行时发生错误。上面的例子中，exp 没有对应的 complex 的处理情况，所以会去寻找强制转换的过程。如果我们定义了 complex->complex 的话，exp 将会变成

(apply-generic exp (complex->complex t1) t2)

所以发生了错误。

如果没有这样一个类型转换，apply-generic 运行时会提示没有找到该类型的处理方法。这才是正确的。

当我们回过去再看 Louis 的观点的时候，会发现他的观点的确值得注意。我们的系统中根本就没有可以处理 complex 的 exp，那我们不应该提示 complex->complex 不存在，而是提示没有处理 complex 的 exp。

我们可以添加一个判断两个类型是否一致的条件语句：

(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 (and (= (length args) 2) (not (eq? (car type-tags)
                                                 (cadr type-tags))))
              (let ((type1 (car type-tags))
                    (type2 (cadr type-tags))
                    (a1 (car args))
                    (a2 (cadr args)))
                (let ((t1->t2 (get-coercion type1 type2))
                      (t2->t1 (get-coercion type2 type1)))
                  (cond (t1->t2
                         (apply-generic op (t1->t2 a1) a2))
                        (t2->t1
                         (apply-generic op a1 (t2->t1 a2)))
                        (else
                         (error "No method for these types"
                                (list op type-tags))))))
              (error "No method for these types"
                     (list op type-tags)))))))

SICP 全笔记