2015/10/31
SICP 問題 2.81
;; a
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc ;;false
(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 ;;true
(apply-generic op (t1->t2 a1) a2)) ;;complex->complex
(t2->t1
(apply-generic op a1 (t2->t1 a2)))
(else (error "No method for these types"
(list op type-tags))))))
(error "Nomethod for these types"
(list op type-tags)))))))
;; 引数に二つの複素数を持ってexpを呼び出すと,
;; procがfalseになり,complexからcomplexへの変換を無限ループする
;; b
;; 無限ループに陥るのでLouisはまちがっている
;; c
(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)
(eq? (car type-tags) (cadr type-tags))) ;;同じtype-tagならエラーになる
(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 "Nomethod for these types"
(list op type-tags)))))))