Show how to generalize

`apply-generic`

to handle coercion in the general case of multiple arguments. One strategy is to attempt to coerce all the arguments to the type of the first argument, then to the type of the second argument, and so on. Give an example of a situation where this strategy (and likewise the two-argument version given above) is not sufficiently general. (Hint: Consider the case where there are some suitable mixed-type operations present in the table that will not be tried.)Let's use the strategy suggested as the basis of our implementation.

In order to implement this we'll need a procedure that can coerce a list of arguments to a particular type, or provides a clear indication when this is not possible, so let's start there.

We can implement such a procedure iteratively, trying to coerce each argument in turn and accumulating a list of coerced arguments as we go. We'll need to

`append`

a `list`

containing the newly-coerced argument at each step, as we want the arguments to end up in the same order as they were originally! This may lead you to question as to why we wouldn't do this recursively using `cons`

to build the resulting list. We could do but, IMNSHO, the iterative approach allows us to provide a cleaner API when we fail to coerce an argument:
- With an iterative implementation if we reach an argument that we fail to coerce we can simply discard the accumulated result so far and instead return a special error value such as
`#f`

. Callers can then easily check whether or not the coercion succeeded. - With a recursive implementation if we reach an argument that we fail to coerce the best we could do would be to return
`'()`

immediately instead of processing the rest of the arguments. The chain of recursive calls so far would still`cons`

their successfully coerced arguments onto this and so the result of the procedure evaluation would be a list containing all of the coerced arguments preceding the failed one. Callers would then need to check the length of the returned list against the expected length to see whether or not the coercion succeeded.

`let*`

, a variant of `let`

that performs the bindings of value to name in sequential order, allowing later bindings to use earlier bindings.We'll also check whether or not an argument is already of the required type before trying to coerce it. If it's already of the required type then we don't need to perform any coercion.

Here's the implementation:

(define (coerce-to target-type remaining-args result) (if (null? remaining-args) result (let* ((arg (car remaining-args)) (original-type (type-tag arg))) (if (eq? original-type target-type) (coerce-to target-type (cdr remaining-args) (append result (list arg))) (let ((original->target (get-coercion (type-tag arg) target-type))) (if original->target (coerce-to target-type (cdr remaining-args) (append result (list (original->target arg)))) #f))))))In order to test this out we'll need to implement the

`get-coercion`

and `put-coercion`

procedures. We can do this for now by simply reserving an operation name in our table for coercion procedures (`'coercion`

will do) and then wrapping the `put`

and `get`

procedures appropriately:
(define (put-coercion source-type target-type proc) (put 'coercion (list source-type target-type) proc)) (define (get-coercion source-type target-type) (get 'coercion (list source-type target-type)))Having done that we can install the example

`scheme-number->complex`

coercion procedure from the Coercion section and then test our `coerce-to`

procedure:
> (coerce-to 'complex (list (make-scheme-number 1) (make-scheme-number 2) (make-scheme-number 3)) '()) ((complex rectangular 1 . 0) (complex rectangular 2 . 0) (complex rectangular 3 . 0)) > (coerce-to 'complex (list (make-scheme-number 1) (make-complex-from-real-imag 2 1) (make-scheme-number 3)) '()) ((complex rectangular 1 . 0) (complex rectangular 2 . 1) (complex rectangular 3 . 0)) > (coerce-to 'complex (list (make-rational 1 2) (make-complex-from-real-imag 2 1) (make-scheme-number 3)) '()) #fThat all looks good, so let's move on to using this to try to coerce the arguments to a type for which there is a suitable procedure to evaluate. If we assume we have a list of types to try out then what we want to do is to iterate through the types until we find one for which we can coerce all the arguments to that type and it is possible to

`get`

a corresponding procedure for arguments of that type. If we manage to find such a type then we'll evaluate the procedure with the coerced arguments, otherwise we'll raise an error.The procedure itself will end up as an inner procedure of our updated

`apply-generic`

, so both the `op`

and `args`

arguments of `apply-generic`

will be in scope. Bearing that in mind we can express this procedure as follows:
(define (apply-generic-iter coercion-types) (if (null? coercion-types) (error "No method for these types, and could not coerce" (list op (map type-tag args))) (let ((coerced-args (coerce-to (car coercion-types) args '()))) (if coerced-args (let ((proc (get op (map type-tag coerced-args)))) (if proc (apply proc (map contents coerced-args)) (apply-generic-iter (cdr coercion-types)))) (apply-generic-iter (cdr coercion-types))))))To test this we'll first extend the

`complex`

package to include a new operation, `addd`

, which adds three complex numbers together:
(define (install-complex-package) ;; imported procedures from rectangular and polar packages … ;; internal procedures … (define (addd-complex z1 z2 z3) (make-from-real-imag (+ (complex-real-part z1) (complex-real-part z2) (complex-real-part z3)) (+ (complex-imag-part z1) (complex-imag-part z2) (complex-imag-part z3)))) … ;; interface to rest of the system … (put 'addd '(complex complex complex) (lambda (z1 z2 z3) (tag (addd-complex z1 z2 z3)))) … 'done)Next we'll define the generic procedure

`addd`

:
(define (addd x y z) (apply-generic 'addd x y z))Finally we can test this by defining

`op`

and `args`

appropriately:
> (define op 'addd) > (define args (list (make-scheme-number 1) (make-scheme-number 2) (make-scheme-number 3))) > (apply-generic-iter '(scheme-number complex)) (complex rectangular 6 . 0) > (define args (list (make-scheme-number 1) (make-complex-from-real-imag 2 1) (make-scheme-number 3))) > (apply-generic-iter '(scheme-number complex)) (complex rectangular 6 . 1) > (define args (list (make-complex-from-real-imag 1 2) (make-scheme-number 3) (make-complex-from-real-imag 4 5))) > (apply-generic-iter '(scheme-number complex)) (complex rectangular 8 . 7)Good stuff!

Now we're almost ready to put all this together... But not quite. First we should think about how we get the list of types to call this with?

The exercise suggests that we

*"attempt to coerce all the arguments to the type of the first argument, then to the type of the second argument, and so on."*We know that we can get a list of the types of the arguments we're called with by evaluating

`(map type-tag args)`

. We could then just iterate through that list and try coercing the arguments to each one in turn. However, this would be wasteful in many cases. If there are multiple arguments of the same type then we'll end up trying to perform the coercion to that type and, if it's successful, try to `get`

the corresponding procedure multiple times.So how can we avoid this? Well obviously it would be more efficient if we only tried each type once. So let's build ourselves a procedure that can take a list and throw out any duplicates. The resulting order isn't too important, so let's define its behaviour as follows: given a list the procedure will

`cons`

the head of the list onto the result of uniquifying the tail of the list iff the tail does not contain the head item. This results in the ordering of the unique list reflecting the ordering of the last occurrence of each item.Here's the procedure:

(define (uniquify l) (if (null? l) '() (let ((head (car l)) (tail (cdr l))) (if (memq head tail) (uniquify tail) (cons head (uniquify tail))))))...and here it is in action:

> (uniquify '(1 2 3 4 3 2 1)) (4 3 2 1) > (uniquify '(1 2 1 3 1 4 1)) (2 3 4 1) > (uniquify '(2 2 2 4 2 3 1 3)) (4 2 1 3)Okay, finally we can put it together, right? We've got a procedure that tries to coerce a list of arguments to a particular type and we've got a procedure that iterates through a list of types, coercing the arguments to each type in turn until it finds a procedure it can evaluate for that type. We've even got a procedure that will enable us to ensure we only try each type once. So we're good to go, right?

Well, almost. There's just one more thing I'd like to consider.

Suppose we get called with a list of arguments all of the same type. We'll try to coerce them to that type which, while it will succeed, is not a necessary operation. So before we start any coercion let's first check to see if there's a procedure installed for the un-coerced types. If there is then we can evaluate it directly. If there isn't then we have to go ahead with extracting the list of types, uniquify it and, if the resulting type list has more than one item in it, try to find an appropriate installed procedure via type coercion.

Why only go ahead with trying to coerce if the uniquified type list has more than one item in it? Well if the type list only has one item in it then all the arguments must be of the same type: the one type in the type list. As a result our coercion procedure will not change the types of any of the arguments and so if a procedure existed for such a type list then our initial check for an appropriate installed procedure should have succeeded.

Oh, and this has the added advantage that if the argument list is of mixed type and there just happens to be a procedure installed that corresponds to that list of types then we'll invoke that. That wouldn't have happened if we'd followed the exercises suggested strategy to the letter.

Right, now we can put it all together:

(define (apply-generic op . args) (define (uniquify l) (if (null? l) '() (let ((head (car l)) (tail (cdr l))) (if (memq head tail) (uniquify tail) (cons head (uniquify tail)))))) (define (coerce-to target-type remaining-args result) (if (null? remaining-args) result (let* ((arg (car remaining-args)) (original-type (type-tag arg))) (if (eq? original-type target-type) (coerce-to target-type (cdr remaining-args) (append result (list arg))) (let ((original->target (get-coercion (type-tag arg) target-type))) (if original->target (coerce-to target-type (cdr remaining-args) (append result (list (original->target arg)))) #f)))))) (define (apply-generic-iter coercion-types) (if (null? coercion-types) (error "No method for these types, and could not coerce" (list op (map type-tag args))) (let ((coerced-args (coerce-to (car coercion-types) args '()))) (if coerced-args (let ((proc (get op (map type-tag coerced-args)))) (if proc (apply proc (map contents coerced-args)) (apply-generic-iter (cdr coercion-types)))) (apply-generic-iter (cdr coercion-types)))))) (let* ((type-tags (map type-tag args)) (proc (get op type-tags))) (if proc (apply proc (map contents args)) (let ((unique-types (uniquify type-tags))) (if (> (length unique-types) 1) (apply-generic-iter unique-types) (else (error "No method for this type" (list op type-tags))))))))Let's see this in action with

`addd`

:
> (addd (make-scheme-number 1) (make-complex-from-real-imag 2 1) (make-scheme-number 3)) (complex rectangular 6 . 1) > (addd (make-complex-from-real-imag 1 2) (make-scheme-number 3) (make-complex-from-real-imag 4 5)) (complex rectangular 8 . 7)Okay, so there's the updated

`apply-generic`

.The exercise also asks us to

*"Give an example of a situation where this strategy (and likewise the two-argument version given above) is not sufficiently general"*. Well there are two situations I can think of where this approach will fail:

- While our implementation will successfully work with mixed-type procedures where there is a procedure installed for the types of the arguments that
`apply-generic`

is called with, it will fail to test for installed procedures of other mixed types. For example, suppose there is a procedure installed for the argument type list of`'(complex scheme-number)`

then a call to`apply-generic`

with arguments with the corresponding type list of`'(scheme-number complex)`

will fail, even if it is possible to coerce the individual arguments to the appropriate types. - Our implementation will only try to coerce to a type if there is at least one argument of that type. At the moment our system has packages installed for the
`scheme-number`

,`rational`

and`complex`

types. However, only the`complex`

package has a procedure installed that implements`addd`

. If we try to evaluate`addd`

with an argument list consisting of only types`scheme-number`

and`rational`

then`apply-generic`

will never try to coerce the arguments to the`complex`

type and so will never find the installed procedure.

## No comments:

## Post a Comment