walker...to the next step

(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 no operation found, we try to coerce the arguments to the type of
      ; each one of them, starting from the first
      (let* ((get-coercion-procs
               ; get-coercion-procs gives a list of coercion procedures
               ; targeting one specific type, if possible
               (lambda (target-type)
                 (map
                   (lambda (arg-type)
                     (if (eq? arg-type target-type)
                       ; if the types are the same, return the identity function
                       identity
                       ; if not, get the coercion function. can be null
                       (get-coercion arg-type target-type)))
                   type-tags))))
        (define (type-tags-iter type-tags)
          (if (not (empty? type-tags))
            (let (coercion-procs (get-coercion-procs (car type-tags)))
              (if (not (member? null coercion-procs))
                ; successful coercion
                (apply-generic op (map apply coercion-procs args))
                ; failed to coerce everything. next round
                (type-tags-iter (cdr type-tags))))
            ; if type-tags is empty, we have tried the type of the last argument
            (error "No method for these types"
                   (list op type-tags))))
        (type-tags-iter type-tags)))))

This method is not general enough when the arguments do have a common ancestor but the ancestor type does not show up in the arguments, thus we can miss it.

An example can be (triangle kite) in figure 2.26. They can both be coerced to polygon but we'll miss it.

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

;; data-directed version

; generic zero? for all numbers
(define (zero? x) (apply-generic 'zero? x))

; inside scheme-number/rational/complex packages. note that we don't need to tag because the result is boolean
(put 'zero? '(scheme-number)
     (lambda (x) (= x 0)))
(put 'zero? '(rational)
     (lambda (x) (= (numer x) 0)))
; delegate to lower layer, or we should say, the sub packages
(put 'zero? '(complex) zero?)

; generic zero? for all complex
(define (zero?-complex x) (apply-generic 'zero? x))

; inside polar/rectangular packages. note that we don't need to tag because the result is boolean
(put 'zero? '(polar)
     (lambda (z) (= (magnitude z) 0)))
(put 'zero? '(rectangular)
     (lambda (z) (and (= (real-part z) 0) (= (imag-part z) 0))))

;; data-directed version
; generic
(define (equ? x y) (apply-generic 'equ? x y))
; inside packages. note that we don't need to tag because the result is boolean
(put 'equ? '(scheme-number scheme-number) =)
(put 'equ? '(rational rational)
     (lambda (x y) (and (= (numer x) (numer y))
                        (= (denom x) (denom y)))))
; we can use real/imag or magnitude/angle, just pick the first one
(put 'equ? '(complex complex)
     (lambda (z1 z2) (and (= (real-part z1) (real-part z2))
                          (= (imag-part z1) (imag-part z2)))))

(define (attach-tag type-tag contents)
  (if (number? contents)
    ; no tag if it's a number
    contents
    (cons type-tag contents)))
(define (type-tag datum)
  ; if it's a number, return the (unused) tag
  (cond ((number? datum) 'scheme-number)
        ((pair? datum) (car datum))
        (else (error "Bad tagged datum -- TYPE-TAG" datum))))
(define (contents datum)
  ; if it's a number, return itself
  (cond ((number? datum) datum)
        ((pair? datum) (cdr datum))
        (else (error "Bad tagged datum -- CONTENTS" datum))))

; then the Scheme number package can remain unmodified

magnitude的定义很简单：

(define (magnitude z) (apply-generic 'magnitude z))

apply-generic的作用其实就是“剥掉”标签，根据标签和op参数查表取得“具体”操作，并执行之。

(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))
          (error
            "No method for these types -- APPLY-GENERIC"
            (list op type-tags))))))

注意我们有两个table，一个是scheme-number/rational/complex的，一个是polar/rectangular的。前者只定义了加减乘除四个操作。“具体”magnitude操作只在后表中定义了。

Alyssa的做法实际上是将magnitude操作注册在第一个表中：

(put 'magnitude '(complex) magnitude)
 
而这里的“具体”magnitude就是前面调用apply-generic的那个。书中前面出现了n多magnitude，但引入data-directed之后，只有这个是全局的。

所以当我们对一个贴着complex标签的数据如(complex (rectangular (3 4)))执行magnitude时，apply-generic首先剥掉complex标签并在第一个表中找到相应的magnitude。这个magnitude其实和刚执行完的是一样的。。。紧接着这个magnitude被执行，参数是刚被剥掉complex标签的数据即(rectangular (3 4))。这个数据是带着polar/rectangular标签的。接下来apply-genericy又被执行，剥掉polar/rectangular标签并找到相应的“真正的”具体操作，再执行。在我们的例子中，针对rectangular的magnitude会被执行在(3 4)上。

也就是说apply-generic被执行了两次。

有了这篇的基础，问题很好回答。

对于GOED，加入新的type需要改动所有的现存operation。加入新的operation则只需新增针对具体type的operation代码，和一个通用operation代码。

对于data-directed，无论是新增type还是operation，都只需在表中加入新内容即可，代码无需改动。

对于MP，加入新type只需新增此具体数据类型的过程表示，和其operation实现即可。加入新的operation则要改动所有现有的type。

所以如若系统中经常引入新type，可使用MP或data-directed。若经常引入新operation，可使用GOED或data-directed。

(define (make-from-mag-ang r a)
  (define (dispatch op)
    (cond ((eq? op 'real-part) (* r (cos a)))
          ((eq? op 'imag-part) (* r (sin a)))
          ((eq? op 'magnitude) r)
          ((eq? op 'angle) a)
          (else
           (error "Unknown op -- MAKE-FROM-MAG-ANG" op))))
  dispatch)

SICP第二章提到了data-directed programming和message passing，及它们的关系。正好最近客户那边重构代码天天提data driven，而且message passing这个词一下让我想到了Smalltalk和OO，所以就把头绪理一下。

考虑一个非常常见的场景：你有两个不同的数据结构，它们其上各自有一组类似但不相同的操作。显然这些操作是针对于各自的具体数据类型的。现在的要求是：

1. 提供一组通用操作作为这两个数据结构的外部接口。
2. 要考虑将来加入新的具体数据类型对系统的影响。
3. 要考虑将来加入新的操作对系统的影响。（感觉OO老是故意回避这个问题。事实上接口变动是很正常很频繁的。当然我设计模式学艺不精，请指正。）

 

按照OO和设计模式的思路，我们应该使用adapter设计模式。Adapter要实现某抽象数据类型，而这个抽象数据类型就是外部接口。client code仅使用此抽象数据类型，这样第一个要求就满足了。至于新加入的具体数据类型，大不了再加adapter就是，对现有代码无需做改动。不过加入新的操作就很麻烦了，每个具体数据类型都要改，抽象数据类型也要改。当然如果新加入的操作对每个具体类型都一样，可以放进抽象数据类型里。

在语言的实现方面，这需要是一个dynamic dispatch/binding的机制。Java和C++都采用了虚函数表，将对于抽象数据类型的操作在运行时映射到具体数据类型。Smalltalk和Python则采用了完全的动态也就是运行时查找，基本就是大查哈希表。

好吧现在我们剥掉OO那个外壳，回到Scheme的朴素思路。还是得有个抽象数据放在这儿当接口，在Scheme中没有object这个把数据和操作绑一起的东西，这个抽象数据其实就是一组通用操作。但现在语言不再自觉地替我们做这些dispatch，或者说将抽象映射到具体的工作了，我们得自己动手了。所以首先最弱智的我们可以用那一手generic operations with explicit dispatch：我们定义通用操作，然后在在其中显式的判断具体数据类型，再调用具体的操作。这一手确实把client code隔离开了，也就是满足了第一条，但显然每加一个具体数据类型都得在每个通用操作里加一个判断分支，没有满足第二条。这就是书中说的not additive。不过如果加一个操作的话还是挺方便的哈，老代码基本不用改。

第二手是用data-directed。其实质就是把那些判断也就是dispatch拿出来放一表或者说registry里。此表以同一具体数据类型的不同操作为列，以不同具体类型的相同操作为行（看SICP 181页或者自己画一个）。表中放的是某一具体数据类型的具体操作。通用操作不再充斥着写死的判断语句，而是接受操作名称作为参数，并从具体数据中获得类型信息，然后查表取得针对具体数据类型的操作并执行之。这样dispatch就成隐式的了，就是一个查表的过程。

所谓的data driven跟这个差不多就一个意思：把代码和数据严格分开，用数据驱动程序，新具体数据类型加进来的时候代码就不用改了。这样的代码就是additive的。详见ESR的Unix编程艺术和Wikipedia。

最后说message passing。它与generic operations with explicit dispatch是相对的。GOED是在operations里包含dispatch，其实质是，每一个operation其实就是data-directed里面的那个表里的一行，根据传入的数据类型自行解决dispatch问题。MP则是，把这个表分割成列，每个data type根据传入的operation自行解决dispatch问题。

在Scheme里表现出来就是，将数据表示为过程（带状态的过程，也就是闭包），其参数是operation。过程内部显式判断operation名称，再做或者调用具体操作。这其实已经是典型的OO特征了。显式判断operation名称就相当于调用实例方法啊！！！相比data-directed，显然是写死了。像Java这种OO语言呢里那些方法名不就是写死的么？当然动态语言除外。Python有个dict大家都知道。所以Scheme这里(object 'method)就相当于Java里object.method()啊！只不过这里dispatch是我们自己写的！而且这个dispatch不是动态的。

哈，object果然就是闭包！

然后SICP里为了提供Scheme风格的数据抽象，对MP也写了个apply-generic函数。据此我们可以再把那些通用操作写出来。比如

(define (real-part z) (apply-generic 'real-part z))

当新的具体数据类型加入时，我们需要写新的过程即可。但加入新操作就费劲了。注意MP和上面OO的局限多么的一致！其实它们的内在就是一样的！

基本思想是，如果我们把数据（具体数据类型）和代码（操作）视作正交，那么GOED和MP各自按住了一个，或者说基于其中一个做模块化，针对另一个做dispatch。所以遇到它们dispatch的那个东西要增加或者减少时，它们划分好的模块就被切了，怎么整都不爽。（想想那个表在按列切的时候多了一行，或按行切的时候多了一列，等于跨了已划分好的模块。）data-directed则是按照这两个维度做模块化，切得更细，需要两个坐标（具体数据类型，操作）才能找到目标。用这个思想看2.76那道题，一目了然。

私以为经验的重要性大致等同于知识，但二者皆低于思想。

老潘终于拿到一本SICP第二版原版实体书~50多刀啊~~~

注意题中说的"keyed"不要想复杂了，用不着动用hash。看一眼之前sets and information retrieval那节。

本例要想运行起来还是有点麻烦的。下面的代码只是看个意思，运行起来会出错。我懒得修补了。

假设J部门用unsorted set来存放员工记录：

(define J-file
  (list
    '(JohnSmith ((salary 1000) (address "J1")))
    '(JoeDoe ((salary 2000) (address "J2")))
    '(JustAnotherGuy ((salary 3000) (address "J3")))
    '(JimCarrey ((salary 100000000) (address "J4")))))
(define (get-record-division-J emp-name)
  (lookup emp-name J-file))
(define get-salary-division-J cadar )
(define get-address-division-J cadadr)
(put 'record 'J-file get-record-division-J)
(put 'salary 'J-file get-salary-division-J)
(put 'address 'J-file get-address-division-J)

A部门则用sorted set：

(define A-file
  (list
    '(AliceInWonderland ((address "A2") (salary 2000)))
    '(Allah ((address "A4") (salary 100000000)))
    '(Amen ((address "A3") (salary 3000)))
    '(Apple ((address "A1") (salary 1000)))))
(define (get-record-division-A emp-name)
  (lookup emp-name A-file))
(define get-salary-division-A emp-name cadadr)
(define get-address-division-A cadar)
(put 'record 'A-file get-record-division-A)
(put 'salary 'A-file get-salary-division-A)
(put 'address 'A-file get-address-division-A)

最后，技术最强的Z部门使用了binary tree...

(define Z-file
  (make-tree
    '(ZipZap (salary 3000) (address "Z3"))
    (make-tree
      '(Zack (salary 1000) (address "Z1")) '() '())
    (make-tree
      '(ZleepZword (salary 2000) (address "Z2")) '() '())))
(define (get-record-division-Z emp-name)
  (lookup emp-name Z-file))
(define get-salary-division-Z cadadr)
(define get-address-division-Z (compose car cdaddr))
(put 'record 'Z-file get-record-division-Z)
(put 'salary 'Z-file get-salary-division-Z)
(put 'address 'Z-file get-address-division-Z)

; a.
; Let's assume that the name of the file is the same as the name of the division.
; Get-record first retrieves the right get-record-division, then applies it to employee name.
; The type information is just the name of the division/file.
(define (get-record emp-name file-name)
  ((get 'record file-name) emp-name))

; b.
; The record should carry the information that which division it's from. Then we can retrieve the corresponding get-salary operation for it.
; This code is only for demonstration purpose.
(define (get-salary record)
  ((get 'salary (get-division record)) record))

; c.
; Use the result from a
(define (find-employee-record emp-name files)
  (let ((emp-record (get-record emp-name (car files))))
    (if emp-record
      emp-record
      (find-employee-record emp-name (cdr files)))))

; d.
; They just need to provide several methods as the "interface" or the "abstraction barrier": get-record-division-X, get-salary-division-X, get-address-division-X, then put them into the registry.
 

; a. The table can be seen as a "registry" from today's perspective.
;    The deriv procedure above:
;     1. if the expression is number or variable, it's easily handled
;     2. if 1 fails, get the corresponding operation according to the "deriv"
;        operation, and the type of the expression - its operator (+, *, etc.)
;     3. apply the operation from 2 to the operands
;    If the type of the expression is number or variable, it doesn't need operation.

; b. We can use get/set like this:
; (get <op> <type>)
; (put <op> <type> <item>)
(define (install-sum-package)
  (define (deriv-sum exp var)
    (make-sum (deriv (addend exp) var)
              (deriv (augend exp) var)))
  (put 'deriv '(sum) deriv-sum))
(define (install-product-package)
  (define (deriv-product exp var)
    (make-sum
      (make-product (multiplier exp)
                    (deriv (multiplicand exp) var))
      (make-product (deriv (multiplier exp) var)
                    (multiplicand exp))))
  (put 'deriv '(product) deriv-product))
; c.
(define (install-exponentiation-package)
  (define (deriv-exponentiation exp var)
    let ((e (exponent exp)) (b (base exp)))
    (make-product
      e
      (make-product
        (make-exponentiation b (make-difference e 1))
        (deriv b var))))
  (put 'deriv '(exponentiation) deriv-exponentiation))
; d. No change is needed in the derivative system. We only need to change 'put'.