SICP-2.81 solution
; Current apply-generic is not bullet-proof: it first tries to get the correct
; operation based on op and type-tags. Only when it fails this step, it tries
; coercion. So the scenario Louis Reasoner described only happens when an
; operation is not registered/installed, thus cannot be found, for 2 numbers of
; the same type.
(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 (= (length args) 2)
(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)))))))
; a. Such a call incurs an infinite recursion. Since the exp operation for 2
; complex numbers is not installed, apply-generic can't find anything in its
; first attempt. Then it tries to coerce the 2 arguments in both ways and
; succeeds immediately, thanks to Louis' installation. But then it's back to
; where it started.
; b. No he's wrong. If the operation of 2 same typed
; operands cannot be found, then let it be, give some errors. Don't try
; coercion since it doesn't change anything in this case.
; c.
(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 (= (length args) 2)
(let ((type1 (car type-tags))
(type2 (cadr type-tags)))
(if (not (eq? type1 type2))
(let ((a1 (car args))
(a2 (cadr args))
(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))))
(error "No method for these types"
(list op type-tags)))))))
; operation based on op and type-tags. Only when it fails this step, it tries
; coercion. So the scenario Louis Reasoner described only happens when an
; operation is not registered/installed, thus cannot be found, for 2 numbers of
; the same type.
(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 (= (length args) 2)
(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)))))))
; a. Such a call incurs an infinite recursion. Since the exp operation for 2
; complex numbers is not installed, apply-generic can't find anything in its
; first attempt. Then it tries to coerce the 2 arguments in both ways and
; succeeds immediately, thanks to Louis' installation. But then it's back to
; where it started.
; b. No he's wrong. If the operation of 2 same typed
; operands cannot be found, then let it be, give some errors. Don't try
; coercion since it doesn't change anything in this case.
; c.
(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 (= (length args) 2)
(let ((type1 (car type-tags))
(type2 (cadr type-tags)))
(if (not (eq? type1 type2))
(let ((a1 (car args))
(a2 (cadr args))
(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))))
(error "No method for these types"
(list op type-tags)))))))
0 条评论: