SICP Exercise 2.81

Question

Louis Reasoner has noticed that apply-generic may try to coerce the arguments to each other’s type even if they already have the same type. Therefore, he reasons, we need to put procedures in the coercion table to coerce arguments of each type to their own type. For example, in addition to the scheme-number->complex coercion shown above, he would do:

(define (scheme-number->scheme-number n) n)
(define (complex->complex z) z)

(put-coercion 'scheme-number 'scheme-number
              scheme-number->scheme-number)

(put-coercion 'complex 'complex
              complex->complex)
  1. With Louis’s coercion procedures installed, what happens if apply-generic is called with two arguments of type scheme-number or two arguments of type complex for an operation that is not found in the table for those types? For example, assume that we’ve defined a generic exponentiation operation:

       (define (exp x y)
         (apply-generic 'exp x y))
    

    and have put a procedure for exponentiation in the Scheme-number package but not in any other package:

       ;; following added to Scheme-number package
       (put 'exp
            '(scheme-number scheme-number)
            (λ (x y)
              (tag (expt x y))))
              ; using primitive expt
    

    What happens if we call exp with two complex numbers as arguments?

  2. Is Louis correct that something had to be done about coercion with arguments of the same type, or does apply-generic work correctly as is?

  3. Modify apply-generic so that it doesn’t try coercion if the two arguments have the same type.

Answer

  1. Before installing Louis' “correction”, we actually get the error message we would expect to receive:

       No method for these types (exp (complex complex))
    

    But after installing Louis' code, we seem to enter an infinite loop and have to manually break the program execution. Why does this happen?

    We are first calling apply-generic with our op being exp and our type-tags being '(complex complex). Since a function corresponding to exp '(complex complex) does not exist, the procedure tries to coerce. This appears to be possible, since there is a coercion procedure available for complex. But because this function just converts it back to complex, we just keep on running apply-generic with the same parameters indefinitely, or until we run out of memory.

  2. Clearly Louis is wrong in his approach since he caused an infinite loop which crashes the program. Coercion is not necessary in case of two equal types.

  3. The simplest way is checking if the type tags are equal at the same time as we check that the length of the tags list is 2:

           (define (apply-generic op . args)
             (let ((type-tags (map type-tag args)))
               (let ((proc (get op type-tags)))
                 (if proc
                     (apply proc (map contents args))
                     (if (and (= (length args) 2)
                              (not (eq? (car type-tags) (cadr type-tags))))
                         (let ((type1 (car type-tags))
                               (type2 (cadr type-tags))
                               (a1 (car args))
                               (a2 (cadr args)))
                           (let ((t1->t2
                                  (get-coercion type1
                                                type2))
                                 (t2->t1
                                  (get-coercion type2
                                                type1)))
                             (cond (t1->t2
                                    (apply-generic
                                     op (t1->t2 a1) a2))
                                   (t2->t1
                                    (apply-generic
                                     op a1 (t2->t1 a2)))
                                   (else
                                    (error
                                     "No method for
                                      these types"
                                     (list
                                      op
                                      type-tags))))))
                         (error
                          "No method for these types"
                          (list op type-tags)))))))