2.77

练习 2.77 Louis Reasoner 试着去求值 (magnitude z)，其中的z就是图2-24里的那个对象。令他吃惊的是，从apply-generic出来的不是5而是一个错误信息，说没办法对类型(complex)做操作magnitude。他将这次交互的情况给Alyssa P. Hacker看，Alyssa说“问题出在没有为complex数定义复数选择函数，而只是为polar和rectangular数定义了它们。你需要做的就是在complex包里加入下面这些东西”：

(put 'real-part '(complex) real-part)
(put 'imag-part '(complex) imag-part)
(put 'magnitude '(complex) magnitude)
(put 'angle '(complex) angle)


' expect 10
(apply + (list 1 2 3 4))


(define (error msg v)
msg
)


(define (attach-tag type-tag contents)
(cons type-tag contents)
)

(define (type-tag datum)
(if (pair? datum)
(car datum)
(error (string-append "Bad tagged datum -- TYPE-TAG" datum))
)
)

(define (contents datum)
(if (pair? datum)
(cdr datum)
(error "Bad tagged datum -- CONTENTS" datum)
)
)

(define (rectangular? z)
(eq? (type-tag z) 'rectangular)
)

(define (polar? z)
(eq? (type-tag z) 'polar)
)

(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op (car type-tags))))
(if proc
(apply proc (map contents args))
(error
"No method for these types -- APPLY-GENERIC"
(list op type-tags)
)
)
)
)
)

(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))


(magnitude z)


z 还不存在。如何表示一个复数？先定义一个 make-complex-from-real-imag 函数：

(define (make-complex-from-real-imag x y)
((get 'make-from-real-imag 'complex) x y)
)

(define z (make-complex-from-real-imag 3 4))


(define helper (js-eval "const table = {}; function get (op, type) {console.log('getting ', op, type);    return table[op][type];} function put (op,type, proc) {    table[op] = table[op] || {};    table[op][type] = proc; } const exports = {get, put, table};
exports;"))

(define JSON (js-eval "JSON"))

(define (get op type)
(js-invoke helper 'get op type)
)

(define (put op type proc)
(js-invoke helper 'put op type proc)
)


(define (square x) (* x x))

(define (install-rectangular-package)
;; internal procedures
(define (real-part z) (car z))
(define (imag-part z) (cdr z))
(define (make-from-real-imag x y) (cons x y))
(define (magnitude z)
(sqrt
(+
(square (real-part z))
(square (imag-part z))
)
)
)
(define (angle z)
(atan
(imag-part z)
(real-part z)
)
)
(define (make-from-mag-ang r a)
(cons
(* r (cos a))
(* r (sin a))
)
)

;; interface to the rest of the system
(define (tag x) (attach-tag 'rectangular x))
(put 'real-part 'rectangular real-part)
(put 'imag-part 'rectangular imag-part)
(put 'magnitude 'rectangular magnitude)
(put 'angle 'rectangular angle)
(put 'make-from-real-imag 'rectangular
(lambda (x y)
(tag
(make-from-real-imag x y)
)
)
)
(put 'make-from-mag-ang 'rectangular
(lambda (r a)
(tag
(make-from-mag-ang r a)
)
)
)
'done
)

(install-rectangular-package)

(define (make-from-real-imag x y)
((get 'make-from-real-imag 'rectangular) x y)
)

(define z (make-from-real-imag 3 4))

z


(type-tag z)


(contents z)

(magnitude z)


(define (install-complex-package)
;; internal procedures

;; interface to the rest of the system
(put 'real-part 'complex real-part)
(put 'imag-part 'complex imag-part)
(put 'magnitude 'complex magnitude)
(put 'angle 'complex angle)
(define (tag x) (attach-tag 'complex x))
(put 'make-complex-from-real-imag 'complex
(lambda (x y)
(tag
(make-from-real-imag x y)
)
)
)
'done
)

(install-complex-package)

(define (make-complex-from-real-imag x y)
((get 'make-complex-from-real-imag 'complex) x y)
)

(define z (make-complex-from-real-imag 3 4))

z


(type-tag z)

(contents z)


(real-part (list 'complex (list 'rectangular 3 4)))
(apply-generic 'real-part (list 'complex (list 'rectangular 3 4)))
((get 'real-part 'complex) (list 'rectangular 3 4))
(real-part (list 'rectangular 3 4))
(apply-generic 'real-part (list 'rectangular 3 4))
((get 'real-part 'rectangular) (list 3 4))
(real-part (list 3 4))
(car (list 3 4))
3

(real-part z)


(magnitude z)