Source code.

(define (apply-generic op . args)
; find the highest type level of a list of arguments
(define (highest-type-level args)
(if (null? args)
0
(let ((level (type-level (car args)))
(highest (highest-type-level (cdr args))))
(if (> level highest)
level
highest))))
; raise arg to the same level as target-type-level
(define (raise-to arg target-type-level)
(define (raise-iter current-arg)
(let ((arg-level (type-level current-arg)))
(cond ((= arg-level target-type-level) current-arg)
((< arg-level target-type-level) (raise-iter (apply-generic 'raise current-arg)))
(else (error "Cannot raise argument to a lower type target" arg target-type-level)))))
(raise-iter arg))
; raise all args to a common type (the highest in the tower of types)
; and apply the operator to them
(define (apply-with-raised-types args)
(let ((target-type-level (highest-type-level args)))
(apply apply-generic
op
(map (lambda (arg)
(raise-to arg target-type-level))
args))))
(let* ((type-tags (map type-tag args))
(proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(apply-with-raised-types args))))

This uses a new top-level generic procedure to find the level of the number type and a new procedure for each of the number types.

(define (type-level z) (apply-generic 'type-level z))
...
...
(put 'type-level '(integer) (lambda (x) 1))
...
...
(put 'type-level '(rational) (lambda (x) 2))
...
...
(put 'type-level '(real) (lambda (x) 3))
...
...
(put 'type-level '(complex) (lambda (x) 4))

To test these we can try out a few generic operations

(display (add (make-integer 3) (make-rational 0 2)))
(rational 3 . 1)
(display (add (make-real 3.1415) (make-rational 0 2)))
(real . 3.1415)
(display (add (make-real 3.1415) (make-complex-from-real-imag 0 2)))
(complex rectangular 3.1415 . 2)
(display (sub (make-integer 3) (make-complex-from-real-imag 1 2)))
(complex rectangular 2 . -2)
(display (mul (make-rational 3 2) (make-complex-from-real-imag 1 2)))
(complex polar 3.3541019662496847 . 1.1071487177940904)
(display (raise (make-integer 3)))
(rational 3 . 1)
(display (raise (raise (make-integer 3))))
(real . 3)
(display (raise (raise (raise (make-integer 3)))))
(complex rectangular 3 . 0)
(display (raise (make-rational 5 4)))
(real . 5/4)
(display (raise (raise (make-rational 5 4))))
(complex rectangular 5/4 . 0)

### Like this:

Like Loading...

*Related*