Serendip

Web Studio

問題2.81

強制型変換に対応した元の 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 (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 o type-tags)))))))

問題a.

apply-generic は引数の型を調べて対応する演算を呼び出す。
(let ((proc (get op type-tags)))
型に対応する演算が無ければ（proc が #f の場合）強制型変換表から適切な型変換手続きを探し出して型変換を行う。
この時、強制型変換表に同じ型への変換手続きがあれば同じ型に変換してしまい無限ループに陥る。

問題b.

Louis は正しくない。
同じ型の引数を強制型変換させようとすると無限ループに陥る。

問題c.

引数が同じ型の場合は強制型変換を行わないように修正した 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)))
                         (if (eq? type1 type2)
                             (error "E1. No method for these types" (list op type-tags))
                             (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 "E2. No method for these types" (list op type-tags))))))
                         (error "E3. No method for these types" (list o type-tags))))))))

(define z (make-complex-from-real-imag 1 2))

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

(put 'exp '(scheme-number scheme-number)
     (lambda (x y) (expt x y)))

(exp 1 z)
gosh> *** ERROR: E1. No method for these types (exp (complex complex))
Stack Trace:
_______________________________________
  0  (error "E2. No method for these types" (list op type-tags))
        At line 63 of "(stdin)"
  1  (error "E2. No method for these types" (list op type-tags))
        At line 63 of "(stdin)"

(exp z 2)
gosh> *** ERROR: E1. No method for these types (exp (complex complex))
Stack Trace:
_______________________________________
  0  (error "E2. No method for these types" (list op type-tags))
        At line 63 of "(stdin)"
  1  (error "E2. No method for these types" (list op type-tags))
        At line 63 of "(stdin)"

(exp z z)
gosh> *** ERROR: E1. No method for these types (exp (complex complex))
Stack Trace:
_______________________________________
  0  (error "E2. No method for these types" (list op type-tags))
        At line 63 of "(stdin)"

(scheme-number complex)、(complex scheme-number) の場合は強制型変換を行った後 (complex complex) に変換されるが、対応する演算（complex 型の exp）が存在しないためエラーとなって終了する。
(complex complex) の場合は型変換は行われず、対応する演算（complex 型の exp）の存在チェックを行いエラーとなって終了する。

計算機プログラムの構造と解釈

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る