sicp-ex-2.82

If we assume the type hierarchy is a tower than types in the hierarchy will always converge onto the same type by promotion. To make sure that we promote all types to a minimum *hight in the tower and preserve the argument order (as it may be important to the procedure we are applying to) I chose a strategy inspired by pivot sort.

Like in pivot sort, break the argument list into 3 lists. Before current after. By promoting each element in before and after to current's type where possible, than recursing on *right shifted before-current-after we maintain argument order. By the final recursion it is assured that all prior arguments to current are either the same type or a subtype which can be promoted to current (unless types are not in the same tower).

  
 (define (apply-generic op . args) 
    
   (define (coerce object target-type) 
     ;; if coerce object to target-type if possible, identity if not 
     (let ((coercion (get-coercion (type-tag object) target-type))) 
       (if coercion (coercion object) object))) 
  
    
   (define (iter before-reference reference after-reference) 
  
     (define (coerce-map objects) 
       ;; convience mapping for coerce 
       (map (lambda (object) 
              (coerce object (type-tag (car reference)))) 
            objects)) 
      
     ;; reconstruct the full arg list for finding procedure and applying 
     (let ((args (append before-reference 
                         reference 
                         after-reference))) 
       (let ((proc (get op (map type-tag args)))) 
         (cond 
           ;; if procedure apply it 
           ((not (null? procedure)) 
            (proc (apply proc (map contents args)))) 
           ;; if we have no reference then no procedure for these types 
           ((null? reference) 
            (error "No method for these types" 
                   (list op (map type-tag args))) 
            ;; if here we have reference 
            ;; coerce types to reference type if posible and try again 
            (else 
             (let ((before-coerced (coerce-map before-reference)) 
                   (after-coerced (coerce-map after-reference))) 
               (cond 
                 ((null? after-reference) 
                  (iter (append before-coerced reference) 
                        nil 
                        nil)) 
                 (else 
                  (iter (append before-coerced reference) 
                        (list (car after-coereced)) 
                        (cdr after-coereced))))))))))) 
    
   ;; start the process by setting reference to the first element 
   (iter nil (list (car args)) (cdr args))) 
  

Only thing is this uses the primitive map, but otherwise I think it works correctly.

  
 (define (any-false? items) 
   (cond ((null? items) false) 
         ((not (car items)) true) 
         (else (any-false? (cdr items))))) 
  
 (define (coerce type-tags args) 
   (define (iter tags) 
     (if (null? tags) 
         false 
         (let ((type-to (car tags))) 
           (let ((coercions 
                  (map (lambda (type-from) 
                         (if (eq? type-from type-to) 
                             (lambda (x) x) ; identity "coercion" for same-types 
                             (get-coercion type-from type-to))) 
                       type-tags))) 
             (if (any-false? coercions) 
                 (iter (cdr tags)) 
                 (map (lambda (coercion arg) (coercion arg)) 
                      coercions 
                      args)))))) 
   (iter type-tags)) 
  
 (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)) 
           (let ((coerced-args (coerce type-tags args))) 
             (if coerced-args 
                 (let ((coerced-type-tags (map type-tag coerced-args))) 
                   (let ((new-proc (get op coerced-type-tags))) 
                     (apply new-proc (map contents coerced-args)))) 
                 (error "No method for these types" 
                        (list op type-tags)))))))) 

Clean solution

  
 (define (apply-generic op . args) 
  
     (define (type-tags args) 
         (map type-tag args)) 
  
     (define (try-coerce-to target) 
         (map (lambda (x) 
                 (let ((coercor (get-coercion (type-tag x) (type-tag target)))) 
                     (if coercor 
                         (coercor x) 
                         x))) 
              args)) 
      
     (define (iterate next) 
         (if (null? next)  
             (error "No coersion strategy for these types " (list op (type-tags args))) 
             (let ((coerced (try-coerce-to (car next)))) 
                 (let ((proc (get op (type-tags coerced)))) 
                     (if proc 
                         (apply proc (map contents coerced)) 
                         (iterate (cdr next))))))) 
  
     (let ((proc (get op (type-tags args)))) 
         (if proc 
             (apply proc (map contents args)) 
             (iterate args)))) 
  
 ; Situation where this is not sufficiently general: 
 ; types: A B C 
 ; registered op: (op some-A some-B some-B) 
 ; registered coercion: A->B C->B 
 ; Situation: Evaluating (apply-generic op A B C) will only try (op A B C), (op B B B) and fail  
 ; while we can just coerce C to B to evaluate (op A B B) instead 

`Exercise 2.82. 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.)

Answer:

  
 ;;iter returns the list of coerced argument or gives an error on failing to find a method. 
  
 (define (apply-generic op . args) 
 (define (iter type-tags args) 
     (if (null? type-tags) 
         (error "No method for these types-ITER") 
         (let ((type1 (car type-tags))) 
           (let ((filtered-args (true-map (lambda (x) 
                         {{{scheme 
                    (let ((type2 (type-tag x))) 
                                              (if (eq? type1 type2) 
                                                  x 
                                                  (let ((t2->t1 (get-coercion type2 type1))) 
                                                    (if (null? t2->t1) #f (t2->t1 x)))))) 
                                          args))) 
             (or filtered-args 
                 (iter (cdr type-tags) args)))))) 
   (let ((type-tags (map type-tag args))) 
     (let ((proc (get op type-tags))) 
       (if (not (null? proc)) 
           (apply proc (map contents args)) 
           (apply apply-generic (cons op (iter type-tags args))))))) 
  
 ;;; true-map function applies proc to each item on the sequence and returns false if any of  
 ;;;;those results was false otherwise returns the list of each results.  
 (define (true-map proc sequence) 
   (define (true-map-iter proc sequence result) 
     (if (null? sequence) 
         (reverse result) 
         (let ((item (proc (car sequence)))) 
           (if item 
               (true-map-iter proc (cdr sequence) (cons item result)) 
               #f)))) 
 (true-map-iter proc sequence '())) 
  
 ;; The following code may be used to try out the solution and see it working. Also you will  
 ;;;need the scheme-number, rational and complex packages and associated generic declarations  
 ;;;;which are not given here. 
  
  
 (define *coercion-table* (make-equal-hash-table)) 
  
 (define (put-coercion type1 type2 proc) 
   (hash-table/put! *coercion-table* (list type1 type2) proc)) 
  
 (define (get-coercion type1 type2) 
   (hash-table/get *coercion-table* (list type1 type2) '())) 
  
 (define (install-coercion-package) 
 (define (scheme-number->complex n) 
   (make-complex-from-real-imag (contents n) 0)) 
 (define (scheme-number->rational n) 
   (make-rational (contents n) 1)) 
 (put-coercion 'scheme-number 'rational scheme-number->rational) 
 (put-coercion 'scheme-number 'complex scheme-number->complex) 
 'done) 
  
 (install-coercion-package) 
  
 ;;The following are some example evaluations 
  
 ;;RESULT 
 ;; 1 ]=> (add (make-scheme-number 1) (make-scheme-number 4)) 
  
 ;; ;Value: 5 
  
 ;; 1 ]=> (add (make-complex-from-real-imag 1 1) (make-complex-from-real-imag 3 2)) 
  
 ;; ;Value 14: (complex rectangular 4 . 3) 
  
 ;; 1 ]=> (add (make-scheme-number 1) (make-complex-from-real-imag 1 1)) 
  
 ;; ;Value 15: (complex rectangular 2 . 1) 
  
 ;; 1 ]=> (add (make-scheme-number 2) (make-rational 3 4)) 
  
 ;; ;Value 16: (rational 11 . 4) 
  
 ;; 1 ]=>  
  

  
  
  
 (define (apply-generic op . arg) 
   ;; if all types can coerced into target-type 
   (define (can-coerced-into? types target-type) 
         (andmap 
           (lambda (type) 
                 (or (equal? type target-type) 
                     (get-coercion type target-type))) 
           types)) 
   ;; find one type that all other types can coerced into 
   (define (find-coerced-type types) 
         (ormap 
           (lambda (target-type) 
                 (if (can-coerced-into? types target-type) 
                   target-type 
                   #f)) 
           types)) 
   ;; coerced args into target-type 
   (define (coerced-all target-type) 
         (map  
           (lamdba (arg) 
                   (let ((arg-type (type-tag arg))) 
                      (if (equal? arg-type target-type) 
                        arg 
                        ((get-coercion arg-type target-type) arg)))) 
           args)) 
   (let ((type-tags (map type-tag args))) 
         (let ((proc (get op type-tags))) 
           (if proc 
             (apply proc (map contents args)) 
               (let ((target-type (find-coerced-type type-tags))) 
                 (if target-type 
                   (apply apply-generic  
                          (append (list op) (coerced-all target-type))) 
                   (error "no method for these types" (list op type-args)))))))) 

In general it coerces argument list to the types in order from first to last and then tries to find a procedure to apply on these arguments. If coercion for pair of types is not found I just put non-coerced element in the coerced list which allows for defining mixed-type procedures. This way I avoid some logic and make things work by convention.

What needs to be done in the rest of the system is to define generic methods to be applicatble on arbitrary number of arguments, since in this point our arithmetic operations work only on 1 or 2 args.

 (define (apply-generic op . args) 
   ; coercing list to a type 
   (define (coerce-list-to-type lst type) 
     (if (null? lst)  
       '() 
       (let ((t1->t2 (get-coercion (type-tag (car lst)) type))) 
         (if t1->t2 
           (cons (t1->t2 (car lst)) (coerce-list-to-type (cdr lst) type)) 
           (cons (car lst) (coerce-list-to-type (cdr lst) type)))))) 
  
   ; applying to a list of multiple arguments 
   (define (apply-coerced lst) 
     (if (null? lst) 
       (error "No method for given arguments") 
       (let ((coerced-list (coerce-list-to-type args (type-tag (car lst))))) 
         (let ((proc (get op (map type-tag coerced-list)))) 
           (if proc 
             (apply proc (map contents coerced-list)) 
             (apply-coerced (cdr lst))))))) 
  
   ; logic to prevent always coercing if there is already direct input entry 
   (let ((type-tags (map type-tag args))) 
     (let ((proc (get op type-tags))) 
       (if proc 
         (apply proc (map contents args)) 
         (apply-coerced args))))) 

the above coerce-list-to-type can be replaced with

 (map (lambda (x) 
            (let ((proc (get-coercion (type-tag x) type))) 
              (if proc (proc x) x))) 
          lst) 

  
  
  
 (define (identity x) x) 
 (define (apply-generic . args) 
  
   (define (inner op . args) 
     (let ((type-tags (map type-tag args))) 
       (let ((proc (get op type-tags))) 
         (if proc 
             (apply proc (map contents args)) 
             (if (coercion-possible? type-tags) 
                 (let ((coercions (get-coercions type-tags))) 
                   (if coercions 
                       (apply inner (cons op (map (lambda (coercion value) 
                                                    (coercion value)) 
                                                  coercions 
                                                  args))) 
                       (error "No method for these types" (list op types)))) 
                 (error "No method for these types" (list op types))))))) 
  
  
  
   ;; Types can be coerced as long as there are types to coerce and there is at least one type 
   ;; to coerce 
   (define (coercion-possible? types) 
     (not (or 
           (null? types) 
           (every (lambda (type) (equal? type (car types))) types)))) 
  
   (define (get-coercions types) 
     ;; Retrieves the coercion functions for each of the provided types, using (car base-types) 
     ;; as the base type. 
     ;; If a coercion function for all requested types to (car base-types) is not found, then  
     ;; try with the next base-type until the list is exhausted. 
     ;;  
     ;; The first parameter is an ordered list of coercion functions. 
     ;; The second parameter is a list of the remaining types in need of a coercion function 
     ;; The third parameter is the list of base types we can use to attempt coercion 
     (define (iter coercions to-coerce base-types) 
       (cond ((null? to-coerce) coercions) 
             ((null? base-types) (error "No method for these types" types)) 
             (else 
              (let ((type (car to-coerce)) 
                    (base-type (car base-types))) 
                (cond ((equal? type base-type) 
                       (iter (append coercions (list identity)) 
                             (cdr to-coerce) 
                             base-types)) 
                      ((get-coercion type base-type) 
                       (iter (append coercions (list (get-coercion type base-type))) 
                             (cdr to-coerce) 
                             base-types)) 
                      (else (iter '() types (cdr base-types)))))))) 
     (iter '() types types)) 
                       
   (apply inner args)) 

A solution more readable and efficient than meteorgan's.

 (define (filter proc seq) 
   (cond ((null? seq) nil) 
         ((proc (car seq)) 
          (cons (car seq) (filter proc (cdr seq)))) 
         (else 
          (filter proc (cdr seq))))) 
  
 (define (apply-generic op . args) 
   ; find the type that all args can be coerced into, through 
   ; filtering the given types. 
   (define (find-generic-type arg-types type-tags) 
     (cond ((null? type-tags) #f) 
           ((null? arg-types) (car type-tags)) 
           ; use car instead of returning the whole list because 
           ; normally, there will be only one existed type. 
           (else 
            (find-generic-type (cdr args) 
                               (find-coercion-types (car args) 
                                                    type-tags))))) 
   ; find the types that the arg can be coerced into among given 
   ; types; this will return a list due to the filter procedure 
   (define (find-coercion-types arg-type type-tags) 
     (filter (lambda (t2) 
               (or (equal? arg-type t2) 
                   (get-coercion arg-type t2))) 
             type-tags)) 
   ; coerce all the args into target-type 
   (define (coerce-all target-type) 
     (map (lambda (arg) 
            (let ((arg-type (type-tag arg))) 
              (if (equal? arg-type target-type) 
                  arg 
                  ((get-coercion arg-type target-type) arg)))) 
          args)) 
  
   (let ((type-tags (map type-tag args))) 
     (let ((proc (get op type-tags))) 
       (if proc 
           (apply proc (map contents args)) 
           (let ((target-type (find-generic-type args))) 
             (if target-type 
                 (apply apply-generic 
                        (cons op (coerced-all target-type))) 
                 (error "no method for these types" 
                        (list op type-args)))))))) 

One of my problems with sicp is figuring out what the authors expect you to do. It seems like a lot of solutions on this page and and elsewhere on the web only work when you update your internal procedures to have a list of more arguments, for example (add '(complex complex complex)) to support 3 arguments. But what if I want to type 4 args or 5 or more? I have to add more entries?

My solution works just by altering apply-generic and using nothing more than the two argument internal functions the authors original present such as (add '(complex complex)).

 (define (apply-gen op . args) 
    
   (define (coerce-all-args op args) 
    
   (define (coerce-to-single-type arg all-args result) 
     (let ((type (type-tag arg)) 
            (type-tags (map type-tag all-args))) 
       (if (null? all-args) (reverse result) 
           (if (eq? type (car type-tags)) 
               (coerce-to-single-type arg (cdr all-args)(cons(car all-args) result)) 
           (let ((proc (get-coercion (car type-tags) type))) 
             (if proc 
                 (coerce-to-single-type arg (cdr all-args)(cons(proc (car all-args)) result)) 
                 #f)))))) 
  
     (define (apply-to-all args op) 
       (displayln args) 
       (define (iter args result)         
         (if (null? args) result 
             (let ((value (contents (car args)))) 
               (iter (cdr args)(if (null? result) 
                                   value 
                                   (op result value)))))) 
       (iter args '())) 
                 
   ;wrapper function to iterate 
   (define (check-all remaining-args) 
     (if (null? remaining-args) 
          (error "no suitable coercion operations found") 
          (let ((coerced-args (coerce-to-single-type (car remaining-args) args '())) 
                (arg-type (type-tag (car remaining-args)))) 
            (if coerced-args 
                (apply-to-all coerced-args (get op (list arg-type arg-type))) 
                (check-all (cdr remaining-args)))))) 
   (check-all args)) 
    
     (let ((type-tags (map type-tag args))) 
     (let ((proc (get op type-tags))) 
       (if proc 
           (apply proc (map contents args)) 
               (coerce-all-args op args))))) 

It's not pretty and it could be more efficient since it does the coercion before it even knows if all the items in a list can be coerced, but at least I don't have to go back and add an item to the internal procedures.

This was written using DrRacket 6.12. lang #racket

Although my solution is inefficient, it should be clearer.

  
  
 ;; Import an accumulator 
 (load "accumulate.scm") 
  
 (define (apply-generic op . args) 
  
     ;; Throws an exception to a procedure call 
     (define (no-method-error tags) 
         (error 
             "No method for these types" 
             (list op tags))) 
      
     ;; Mandatory conversion process table for tabulating parameters 
     ;; Returns a two-dimensional process table 
     ;; Item quantity: (square (length args)) 
     (define (coercion-proc-table args) 
         (map 
             (lambda (x) 
                 (let ((type-x (type-tag x))) 
                     (map 
                         (lambda (y) 
                             (let ((type-y (type-tag y))) 
                                 (if (eq? type-x type-y) 
                                     (lambda (this) this) 
                                     (get-coercion type-y type-x)))) 
                         args))) 
             args)) 
      
     ;; Searching for Conversion Processes Sequences 
     ;; If not, return null 
     (define (find-proc-list table) 
         (filter 
             (lambda (proc-seq) 
                 (accumulate and #t proc-seq)) 
             table)) 
      
     ;; Conversion parameter list 
     (define (coercion-transform proc-seq args) 
         (map 
             (lambda (f x) (f x)) 
             proc-seq 
             args)) 
      
     ;; Main logic 
     (let ((type-tags (map type-tag args))) 
         (let ((proc (get op type-tags))) 
             (if proc 
                 (apply proc (map contents args)) 
                 (let ((proc-list (find-proc-list (coercion-proc-table args)))) 
                     (if (null? proc-list) 
                         (no-method-error type-tags) 
                         (let ((new-args (coercion-transform (car proc-list) args))) 
                             (let ((new-type-tags (map type-tag new-args))) 
                                 (if (equal? new-type-tags type-tags) 
                                     (no-method-error type-tags) 
                                     (apply apply-generic (cons op new-args))))))))))) 
  
  
  
  

Version with counter

  
 #lang sicp 
 (define (apply-generic op . args) 
  
   (define (no-method type-tags) 
     (error 
      "No method for these types" 
      (list op type-tags))) 
  
   (define (apply-generic-count op counter . args) 
     (let ((type-tags (map type-tag args))) 
       (if (= counter 0) 
           (no-method type-tags) 
           (let ((proc (get op type-tags))) 
             (if proc 
                 (apply proc (map contents args)) 
                 (let ((coercion-list (get-coercion-list (car type-tags) (cdr type-tags)))) 
                   (if (valid? coercion-list) 
                       (apply-generic-count op counter 
                                            (car args) 
                                            (apply-coercion-list (cdr args))) 
                       (apply-generic-count op (dec counter) 
                                            (cdr args) 
                                            (car args))))))))) 
  
   (apply-generic-count op (length args) args) 
  
   (define (get-coercion-list type type-list) 
     (map (lambda (x) (get-coercion x type)) type-list)) 
  
   (define (valid? coercion-list) 
     (accumulate and true coercion-list)) 
  
   (define (apply-coercion-list coercion-list type-list) 
     (map (lambda (f x) f x) coercion-list type-list))) 
  
  

I think my solution is rather elegent, and easy to read. My approach is to generate a list of coercing procedures and then use map on the list of argument.

 ;; any null in the list? 
 (define (has-null? seq) 
   (memq '() seq)) 
  
 ;; Generate a list of coercion procedures, and the apply each one to the 
 ;; corresponding arguement. 
 (define (coerce args-list) 
   (define (coerce-helper remaining) 
     (cond (((null? remaining) (error "Not possible to coerce")) 
            (else 
              (let ((master-arg (car remaining))) 
                (let ((master-type (type-tag master-arg))) 
                  (let ((procedure-list 
                          (map (lambda (somearg) 
                                 (let ((sometype (type-tag somearg))) 
                                   (if (eq? sometype master-type) (lambda (x) x) ; if they have the same type, then subsitute with the idenitity 
                                     (get-coercion sometype master-type)))) 
                                 args-list))) 
                        (if (has-null? procedure-list) ; is the coersion procedures list valid? 
                          (coerce-helper (cdr remaining)) ; try the next master-type 
                          (map apply procedure-list args-list))))))))) ; apply the nth coercion to the nth argument 
     (coerce-helper args-list)) 
  
 ;; This startegy won't work unless we explecity define coercions of the form 
 ;; t1->t3, we can't for instance use t1->t2 and then t2->t3 without defining 
 ;; them first 
  
 ;; does the list have any #f? 
 (define (has-false? seq) 
   (memq #f seq))  
  
 ;; are all elements of the list the same? 
 (define (all-same? seq) 
   (cond ((null? seq) true) 
         (else 
           (let ((first (car seq))) 
             (has-false? 
               (map (lambda (somearg) 
                      (eq? somearg first)))))))) 
  
 ;; if `proc` does not exist, and the arguments are NOT of the same type, then 
 ;; try apply-generic with the coerced arguements  
 (define (apply-generic op . args) 
   (let ((type-tags (map type-tag args))) 
     (let ((proc (get op type-tags))) 
       (cond (proc (apply proc (map contents args))) 
             ((all-same? type-tags) 
              (error "No method for these types" (list op type-tags))) 
             (else 
               (apply-generic op (coerce args))))))) 
  

My approach is to coerce the list args into a coerced list of args of equal type. The coercion of an individual arg is done in the same way as the two arg version given in the book.

 (define (coerce-lst-from-to uncoerced coerced) 
   (if (null? uncoerced) 
       coerced 
       (let* 
           ((coerced-item      (car coerced)) 
            (uncoerced-item    (car uncoerced)) 
            (l-uncoerced-item  (list uncoerced-item)) 
                 
            (type-c            (type-tag coerced-item)) 
            (type-u            (type-tag uncoerced-item)) 
            (same-type?        (eq? type-c type-u)) 
                 
            (tu->tc            (if (not same-type?) 
                                   (get-coercion type-u type-c) 
                                   false)) 
            (tc->tu            (if (not tu->tc) 
                                   (get-coercion type-c type-u) 
                                   false)) 
  
            (new-coerced-lst   (cond (same-type? 
                                      (append coerced l-uncoerced-item)) 
                                      
                                     (tu->tc 
                                      (append coerced (list (tu->tc uncoerced-item)))) 
                                      
                                     (tc->tu 
                                      (append (map tc->tu coerced) l-uncoerced-item)) 
                                      
                                     (else false))) 
  
            (new-uncoerced-lst (cdr uncoerced))) 
              
         (if new-coerced-lst 
             (coerce-lst-from-to new-uncoerced-lst new-coerced-lst) 
             false)))) 
  
 (define (coerce-list lst) 
   (if (null? lst) 
       lst 
       (coerce-lst-from-to (cdr lst) (list (car lst))))) 
  
 (define (eq-types-from-to type type-lst) 
   (if (null? type-lst) 
       true 
       (if (eq? type (car type-lst)) 
           (eq-types-from-to type (cdr type-lst)) 
           false))) 
  
 (define (eq-types? type-tags) 
   (if (null? type-tags) 
       false 
       (if (= (length type-tags) 1) 
           true 
           (eq-types-from-to (car type-tags) (cdr type-tags))))) 
  
 ;; Apply-generic with coercion 
 (define (apply-generic op . args) 
   (let* ((type-tags (map type-tag args)) 
          (proc (get op type-tags))) 
     (if proc 
         (apply proc (map contents args)) 
         (if (and (> (length args) 1) (not (eq-types? type-tags))) 
             (let ((coerced-args (coerce-list args))) 
               (if coerced-args 
                   (apply apply-generic (cons op coerced-args)) 
                   (error  
                    "No method for types [2]" 
                    (list op type-tags)))) 
             (error  
              "No method for types [1]" 
              (list op type-tags)))))) 
  

My solution is very similar to 2bdkid, but with some cleanups. Lab test just came back, this is the cleanest solution ;)

  
 (define (none predicate elems) 
   (null? (filter predicate elems))) 
  
 ;; attempt to coerce all args to the same type, or nil if not possible. 
 ;; uses a naive algorithm (try to coerce all args to type of the first arg, then second, etc.) 
 (define (coerce-args args) 
   (define (iter type-tags) 
     (if (null? type-tags) 
         '() 
         (let* ((target-type (car type-tags)) 
                (coercions (map (lambda (type) 
                                  (if (eq? type target-type) 
                                      (lambda (x) x) 
                                      (get-coercion type target-type))) 
                                type-tags))) 
           ;; did we find a coercion for all args? 
           (if (none null? coercions) 
               (map (lambda (coerce arg) (coerce arg)) coercions args) 
               (iter (cdr type-tags)))))) 
   (iter (map type-tag args))) 
  
 (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)) 
           (let ((coerced-args (coerce-args args))) 
             (if coerced-args 
                 (apply-generic op coerced-args) 
                 (error "No method for these types" (list op type-tags))))))))