Exercise 2.84

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)
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s