問題2-81

複数の異なるデータ型を演算できるように機能追加していきます。まずは、Louis Reasonerの仮説が正しいかどうかを確認していきます。

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

上記のように、演算する要素が同じ型同士だったとしても、それらを強制変換する必要があるのかという問いです。例えば、べき乗の演算を

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

(define (install-scheme-number-package)
  ;;...other
  (put 'exp '(scheme-number scheme-number)
       (lambda (x y) (tag (expt x y))))
  ;;...other  
  'done)

のように定義すると、scheme-numberの場合は上手くいきますが、演算ロジックを追加していない複素数で試みると無限ループに陥ってしまいます。

(define z1
  (make-complex-from-real-imag 3 1))

(exp 3 4)  ;=>81
(exp z1 z1)  ;=>無限ループ

この無限ループは、強制型変換ロジックを追加したapply-genericの中で起こっていることだと思われます。(get 'complex 'complex)によって、complex->complexが呼び出されますが、これは渡された引数をそのまま返しているだけです。そのため、型や値は何も変わらないまま、apply-genericが永遠に再帰してしまいます。
同じ型同士だったら、型変換を行う前の、通常のgetを使って然るべき演算が行なわれるべきだと思うので、同じ型ならget-coercionが適用されないように、apply-genericを修正します。

(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 ((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 ((eq? type1 type2)
                         (error "No method for these same types"
                                (list op type-tags)))                              
                        (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)))))))

これで、最初は異なる引数が渡されて一方が型変換を行なわれた結果、互いが同じ型になったのにも関わらず、適用すべき手続きを見つけられないという場合でも、適切なエラーを表示することができます。
次の問題2-82で問われている、3個以上の引数に対応する問題は、今の自分にはちょっと難しすぎるような気がしているので、後に回します。