1 (define (attach-tag type-tag contents)
2   (if (number? contents)
3       contents
4       (cons type-tag contents)))
5 
6 (define (apply-generic op . args)
7   (let ((type-tags (map type-tag args)))
8     (let ((proc (get op type-tags)))
9       (if proc
10 	  (apply proc (map contents args))
11 	  (error "No method for these types -- APPLY-GENERIC"
12 		 (list op type-tags))))))
13 
14 (define (apply-generic op . args)
15   (let ((type-tags (map type-tag args)))
16     (let ((proc (get op type-tags)))
17       (if proc
18 	  (apply proc (map contents args))
19 	  (if (= (length args) 2)
20 	      (let ((type1 (car type-tags))
21 		    (type2 (cadr type-tags))
22 		    (a1 (car args))
23 		    (a2 (cadr args)))
24 		(let ((t1->t2 (get-coercion type1 type2))
25 		      (t2->t1 (get-coercion type2 type1)))
26 		  (cond (t1->t2
27 			 (apply-generic op (t1->t2 a1) a2))
28 			(t2->t1
29 			 (apply-generic op a1 (t2->t1 a2)))
30 			(else
31 			 (error "No method for these types"
32 				(list op type-tags))))))
33 	      (error "No method for these types"
34 		     (list op type-tags)))))))
35