这题所涉及的程序众多,完整的源码在后面给出。
首先重现 Louis 所遇到的问题:
1 ]=> (load "77-louis-complex.scm")
;Loading "77-louis-complex.scm"...
; Loading "p123-install-rectangular-package.scm"...
; Loading "p119-tag.scm"... done
; Loading "p123-put-and-get.scm"... done
; ... done
; Loading "p124-install-polar-package.scm"...
; Loading "p119-tag.scm"... done
; Loading "p123-put-and-get.scm"... done
; ... done
; Loading "p130-install-complex-package.scm"...
; Loading "p119-tag.scm"... done
; Loading "p123-put-and-get.scm"... done
; ... done
; Loading "p125-generic-selector.scm"...
; Loading "p125-apply-generic.scm"...
; Loading "p119-tag.scm"... done
; ... done
; ... done
;... done
;Value: done
1 ]=> (magnitude (make-complex-from-real-imag 3 4))
;No method for these types -- APPLY-GENERIC (magnitude (complex))
;To continue, call RESTART with an option number:
; (RESTART 1) => Return to read-eval-print level 1.
2 error>
当 Louis 求值表达式 (magnitude z)
时,有以下执行过程:
(magnitude z)
(apply-generic 'magnitude z)
(map type-tag (list z)) ; => '(complex)
(get 'magnitude '(complex)) ; => #f
(error ...)
从执行过程可以看出, apply-generic
试图寻找 '(complex)
类型的 'magnitude
操作,但是该操作并不存在,所以它返回 #f
,并引发一个错误。
要让这个复数系统的 magnitude
函数以及其他通用选择符正常运作,我们需要像 Alyssa 说的那样,为 '(complex)
类型关联相应的操作函数才行。
以下是新的复数系统:
1 ]=> (load "77-alyssa-complex.scm")
;Loading "77-alyssa-complex.scm"...
; Loading "p123-install-rectangular-package.scm"...
; Loading "p119-tag.scm"... done
; Loading "p123-put-and-get.scm"... done
; ... done
; Loading "p124-install-polar-package.scm"...
; Loading "p119-tag.scm"... done
; Loading "p123-put-and-get.scm"... done
; ... done
; Loading "p125-apply-generic.scm"...
; Loading "p119-tag.scm"... done
; ... done
; Loading "p125-generic-selector.scm"...
; Loading "p125-apply-generic.scm"...
; Loading "p119-tag.scm"... done
; ... done
; ... done
; Loading "77-install-alyssa-complex-package.scm"...
; Loading "p123-put-and-get.scm"... done
; Loading "p119-tag.scm"... done
; ... done
;... done
;Value: done
1 ]=> (magnitude (make-complex-from-real-imag 3 4))
;Value: 5
在 Alyssa 的复数系统中求值表达式 (magnitude z)
,有以下执行过程:
(magnitude z) ; 这个 magnitude 是最外层的通用操作
(apply-generic 'magnitude z)
(map type-tag (list z)) ; => '(complex)
(get 'magnitude '(complex)) ; => magnitude ; 这个 magnitude 是定义于 complex 包中的 magnitude
(apply magnitude (map contents (list z))) ; => (apply magnitude '((rectangular 3 . 4)))
(magnitude '(rectangular 3 . 4))
(apply-generic 'magnitude '(rectangular 3 . 4))
(map type-tag (list '(rectangular 3 . 4))) ; => '(rectangular)
(get 'magnitude '(rectangular)) ; => magnitude ; 这个 magnitude 是定义于 rectangular 包中的 magnitude
(apply magnitude (map contents (list '(rectangular 3 . 4)))) ; => (apply magnitude '((3 . 4)))
(magnitude '(3 . 4))
(sqrt (+ (square (real-part '(3 . 4)))
(square (imag-part '(3 . 4)))))
5
可以看出,复数系统共调用了三次 magnitude
函数,第一次调用的是外层的通用操作函数 magnitude
,第二次调用的是定义在 (install-complex-package)
包内的 magnitude
函数,第三次调用的是定义在 (install-rectangular-package)
包内的 magnitude
函数;从某种意义上来看,这三个 magnitude
组成了一个完整的通用操作 magnitude
,但从个体上看,这三个 magnitude
都不是同一个东西。
另外 apply-generic
调用了两次,第一次调用它剥去数据上的 complex
标示,并调用 (install-rectangular-package)
包中的 magnitude
函数;第二次调用它剥去数据上的 rectangular
标示,并调用 (install-rectangular-package)
包中的 magnitude
函数。
主体程序:
;;; 77-louis-complex.scm
(load "p123-install-rectangular-package.scm")
(load "p124-install-polar-package.scm")
(load "p130-install-complex-package.scm")
(load "p125-generic-selector.scm")
(install-polar-package)
(install-rectangular-package)
(install-complex-package)
rectangular 包:
;;; p123-install-rectangular-package.scm
(load "p119-tag.scm")
(load "p123-put-and-get.scm")
(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)
(define (make-from-real-imag x y)
((get 'make-from-real-imag 'rectangular) x y))
polar 包:
;;; p124-install-polar-package.scm
(load "p119-tag.scm")
(load "p123-put-and-get.scm")
(define (install-polar-package)
;; internal procedures
(define (magnitude z) (car z))
(define (angle z) (cdr z))
(define (make-from-mag-ang r a) (cons r a))
(define (real-part z)
(* (magnitude z) (cos (angle z))))
(define (imag-part z)
(* (magnitude z) (sin (angle z))))
(define (make-from-real-imag x y)
(cons (sqrt (+ (square x) (square y)))
(atan y x)))
;; interface to the rest of the system
(define (tag x) (attach-tag 'polar x))
(put 'real-part '(polar) real-part)
(put 'imag-part '(polar) imag-part)
(put 'magnitude '(polar) magnitude)
(put 'angle '(polar) angle)
(put 'make-from-real-imag 'polar
(lambda (x y) (tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'polar
(lambda (r a) (tag (make-from-mag-ang r a))))
'done)
(define (make-from-mag-ang r a)
((get 'make-from-mag-ang 'polar) r a))
apply-generic
函数:
;;; p125-apply-generic.scm
(load "p119-tag.scm")
(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))))))
magnitude
、 angle
等四个通用选择器:
;;; p125-generic-selector.scm
(load "p125-apply-generic.scm")
(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))
复数包:
;;; p130-install-complex-package.scm
(load "p119-tag.scm")
(load "p123-put-and-get.scm")
(define (install-complex-package)
;; imported procedures from rectangular and polar packages
(define (make-from-real-imag x y)
((get 'make-from-real-imag 'rectangular) x y))
(define (make-from-mag-ang r a)
((get 'make-from-mag-ang 'polar) r a))
;; internal procedures
(define (add-complex z1 z2)
(make-from-real-imag (+ (real-part z1) (real-part z2))
(+ (imag-part z1) (imag-part z2))))
(define (sub-complex z1 z2)
(make-from-real-imag (- (real-part z1) (real-part z2))
(- (imag-part z1) (imag-part z2))))
(define (mul-complex z1 z2)
(make-from-mag-ang (* (magnitude z1) (magnitude z2))
(+ (angle z1) (angle z2))))
(define (div-complex z1 z2)
(make-from-mag-ang (/ (magnitude z1) (magnitude z2))
(- (angle z1) (angle z2))))
;; interface to rest of the system
(define (tag z)
(attach-tag 'complex z))
(put 'add '(complex complex)
(lambda (z1 z2)
(tag (add-complex z1 z2))))
(put 'sub '(complex complex)
(lambda (z1 z2)
(tag (sub-complex z1 z2))))
(put 'mul '(complex complex)
(lambda (z1 z2)
(tag (mul-complex z1 z2))))
(put 'div '(complex complex)
(lambda (z1 z2)
(tag (div-complex z1 z2))))
(put 'make-from-real-imag 'complex
(lambda (x y)
(tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'complex
(lambda (x y)
(tag (make-from-mag-ang x y))))
'done)
(define (make-complex-from-real-imag x y)
((get 'make-from-real-imag 'complex) x y))
(define (make-complex-from-mag-ang r a)
((get 'make-from-mag-ang 'complex) r a))
put
函数和 get
函数:
;;; p123-put-and-get.scm
(load "p186-make-table.scm")
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
标识(tag)处理函数:
;;; p119-tag.scm
(define (attach-tag type-tag contents)
(cons type-tag contents))
(define (type-tag datum)
(if (pair? datum)
(car datum)
(error "Bad tagged datum -- TYPE-TAG" datum)))
(define (contents datum)
(if (pair? datum)
(cdr datum)
(error "Bad tagged datum -- CONTENTS" datum)))
Alyssa 的复数系统除了主体程序和复数包和 Louis 的复数系统不同外,其他几个辅助程序都一样。
主体程序:
;;; 77-alyssa-complex.scm
(load "p123-install-rectangular-package.scm")
(load "p124-install-polar-package.scm")
(load "p125-apply-generic.scm")
(load "p125-generic-selector.scm")
(load "77-install-alyssa-complex-package.scm") ; 更改
(install-rectangular-package)
(install-polar-package)
(install-complex-package)
修改过的复数包:
;;; 77-install-alyssa-complex-package.scm
(load "p123-put-and-get.scm")
(load "p119-tag.scm")
(define (install-complex-package)
;;; imported procedures from rectangular and polar packages
(define (make-from-real-imag x y)
((get 'make-from-real-imag 'rectangular) x y))
(define (make-from-mag-ang r a)
((get 'make-from-mag-ang 'polar) r a))
;;; interal procedures
(define (add-complex z1 z2)
(make-from-real-imag (+ (real-part z1) (real-part z2))
(+ (imag-part z1) (imag-part z2))))
(define (sub-complex z1 z2)
(make-from-real-imag (- (real-part z1) (real-part z2))
(- (imag-part z1) (imag-part z2))))
(define (mul-complex z1 z2)
(make-from-mag-ang (* (magnitude z1) (magnitude z2))
(+ (angle z1) (angle z2))))
(define (div-complex z1 z2)
(make-from-mag-ang (/ (magnitude z1) (magnitude z2))
(- (angle z1) (angle z2))))
;;; interface to rest of the system
(define (tag z)
(attach-tag 'complex z))
(put 'add '(complex complex)
(lambda (z1 z2)
(tag (add-complex z1 z2))))
(put 'sub '(complex complex)
(lambda (z1 z2)
(tag (sub-complex z1 z2))))
(put 'mul '(complex complex)
(lambda (z1 z2)
(tag (mul-complex z1 z2))))
(put 'div '(complex complex)
(lambda (z1 z2)
(tag (div-complex z1 z2))))
(put 'make-from-real-imag 'complex
(lambda (x y)
(tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'complex
(lambda (r a)
(tag (make-from-mag-ang r a))))
; 新增
(put 'real-part '(complex) real-part)
(put 'imag-part '(complex) imag-part)
(put 'magnitude '(complex) magnitude)
(put 'angle '(complex) angle)
'done)
(define (make-complex-from-real-imag x y)
((get 'make-from-real-imag 'complex) x y))
(define (make-complex-from-mag-ang r a)
((get 'make-from-mag-ang 'complex) r a))