1 665c255d 2023-08-04 jrmu (define (apply-generic op . args)
 2 665c255d 2023-08-04 jrmu   (define (try-convert x new-type)
 3 665c255d 2023-08-04 jrmu     (let ((converter (get-coercion (type-tag x) new-type)))
 4 665c255d 2023-08-04 jrmu       (if converter
 5 665c255d 2023-08-04 jrmu 	  (converter x)
 6 665c255d 2023-08-04 jrmu 	  x)))
 7 665c255d 2023-08-04 jrmu   (define (apply-generic-1 op args type-list)
 8 665c255d 2023-08-04 jrmu     (if (null? type-list)
 9 665c255d 2023-08-04 jrmu 	(error "No method for these types"
10 665c255d 2023-08-04 jrmu 	       (list op (map type-tag args)))
11 665c255d 2023-08-04 jrmu 	(let ((new-args (map (lambda (x)
12 665c255d 2023-08-04 jrmu 			       (try-convert x (car type-list)))
13 665c255d 2023-08-04 jrmu 			     args)))
14 665c255d 2023-08-04 jrmu 	  (let ((new-type-tags (map type-tag new-args)))
15 665c255d 2023-08-04 jrmu 	    (let ((proc (get op new-type-tags)))
16 665c255d 2023-08-04 jrmu 	      (if proc
17 665c255d 2023-08-04 jrmu 		  (apply proc (map contents new-args))
18 665c255d 2023-08-04 jrmu 		  (apply-generic-1 op args (cdr type-list))))))))
19 665c255d 2023-08-04 jrmu   (let ((type-tags (map type-tag args)))
20 665c255d 2023-08-04 jrmu     (let ((proc (get op type-tags)))
21 665c255d 2023-08-04 jrmu       (if proc
22 665c255d 2023-08-04 jrmu 	  (apply proc (map contents args))
23 665c255d 2023-08-04 jrmu 	  (apply-generic-1 op args type-tags)))))