読者です 読者をやめる 読者になる 読者になる

(wat-aro)

無職から有職者にランクアップしました

SICP 問題 2.81

scheme SICP
;; 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)))))))