理系学生日記

おまえはいつまで学生気分なのか

問題2-81c (2.5.2 Combining Data of Different Types)

2つの引数に同じタグがついていて(同じ型の引数で)、その2つに対する演算がテーブルに定義されなかったときはcoercionをしないようにしろという課題。
単純にタグを比べればいいだけっぽい。

(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 "あほか")
		    (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))))))))