3 (define (type-height type)
5 ((eq? type 'integer) 0)
6 ((eq? type 'rational) 1)
8 ((eq? type 'complex) 3)))
11 (lambda (x) (f (g x))))
13 (define (identity x) (lambda (x) x))
15 (define (raise-to type1 type2)
18 (let ((t1->upper (get 'raise (list type1))))
19 (compose t1->upper (raise-to t1->upper type2)))))
21 (define (apply-generic op . args)
22 (let ((type-tags (map type-tag args)))
23 (let ((proc (get op type-tags)))
25 (apply proc (map contents args))
26 (if (= (length args) 2)
27 (let ((type1 (car type-tags))
28 (type2 (cadr type-tags))
31 (let ((th1 (type-height type1))
32 (th2 (type-height type2)))
34 (let ((t2->t1 (raise-to type2 type1)))
36 (apply-generic op a1 (t2->t1 a2))
37 (error "cannot coerce type2 to type1")))
38 (let ((t1->t2 (raise-to type1 type2)))
40 (apply-generic op (t1->t2 a1) a2)
41 (error "cannot coerce type1 to type2")))))))))))