这道题和 练习 2.79 类似,都是为各个包添加通用操作。
首先将 =zero?
函数的通用函数写下来:
;;; 80-zero.scm
(load "p125-apply-generic.scm")
(define (=zero? x)
(apply-generic '=zero? x))
然后分别在几个包中实现这个 =zero?
函数的数据导向操作。
一个值 value
对于 =zero?
为真当且仅当这个值等于 0
:
;;; 80-install-scheme-number-package.scm
(load "p123-put-and-get.scm")
(load "p119-tag.scm")
(define (install-scheme-number-package)
(define (tag x)
(attach-tag 'scheme-number x))
(put 'make 'scheme-number
(lambda (x)
(tag x)))
;; 新增
(put '=zero? '(scheme-number)
(lambda (value)
(= value 0)))
'done)
(define (make-scheme-number n)
((get 'make 'scheme-number) n))
测试:
1 ]=> (load "80-install-scheme-number-package.scm")
;Loading "80-install-scheme-number-package.scm"...
; Loading "p123-put-and-get.scm"... done
; Loading "p119-tag.scm"... done
;... done
;Value: make-scheme-number
1 ]=> (load "80-zero.scm")
;Loading "80-zero.scm"...
; Loading "p125-apply-generic.scm"...
; Loading "p119-tag.scm"... done
; ... done
;... done
;Value: =zero?
1 ]=> (install-scheme-number-package)
;Value: done
1 ]=> (=zero? (make-scheme-number 0))
;Value: #t
1 ]=> (=zero? (make-scheme-number 10086))
;Value: #f
有理数包程序可以在书本 129 页的 (install-rational-package)
源码的基础上进行修改,一个有理数为零当且仅当它的分子为 0
:
;;; 80-install-rational-package.scm
(load "p123-put-and-get.scm")
(load "p119-tag.scm")
(define (install-rational-package)
(define (numer x)
(car x))
(define (denom x)
(cdr x))
(define (make-rat n d)
(let ((g (gcd n d)))
(cons (/ n g) (/ d g))))
;;; interface to rest of the system
(define (tag x)
(attach-tag 'rational x))
(put 'make 'rational
(lambda (n d)
(tag (make-rat n d))))
;;; 新增
(put '=zero? '(rational)
(lambda (r)
(= 0 (numer r))))
'done)
(define (make-rational n d)
((get 'make 'rational) n d))
测试:
1 ]=> (load "80-install-rational-package.scm")
;Loading "80-install-rational-package.scm"...
; Loading "p123-put-and-get.scm"... done
; Loading "p119-tag.scm"... done
;... done
;Value: make-rational
1 ]=> (load "80-zero.scm")
;Loading "80-zero.scm"...
; Loading "p125-apply-generic.scm"...
; Loading "p119-tag.scm"... done
; ... done
;... done
;Value: =zero?
1 ]=> (install-rational-package)
;Value: done
1 ]=> (=zero? (make-rational 0 1))
;Value: #t
1 ]=> (=zero? (make-rational 10086 10086))
;Value: #f
一个复数为 0
当且仅当它的 real-part
和 imag-part
都为 0
。
为了方便起见,直接在 练习 2.79 的程序的基础上进行修改:
;;; 80-install-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))
;;; interface to rest of the system
(define (tag z)
(attach-tag 'complex z))
(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))))
;; 补充完整缺少的选择函数(练习 2.77)
(put 'real-part '(complex) real-part)
(put 'imag-part '(complex) imag-part)
(put 'magnitude '(complex) magnitude)
(put 'angle '(complex) angle)
;;; 新增
(put '=zero? '(complex)
(lambda (c)
(and (= 0 (real-part c))
(= 0 (imag-part c)))))
'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))
为了方便包的载入,我么还需要修改 练习 2.79 的复数包载入驱动:
;;; 80-complex-driver.scm
(load "p123-install-rectangular-package.scm")
(load "p124-install-polar-package.scm")
(load "p125-generic-selector.scm")
(load "80-install-complex-package.scm") ; 修改
(load "80-zero.scm")
(install-rectangular-package)
(install-polar-package)
(install-complex-package)
测试:
1 ]=> (load "80-install-complex-package.scm")
;Loading "80-install-complex-package.scm"...
; Loading "p123-put-and-get.scm"... done
; Loading "p119-tag.scm"... done
;... done
;Value: make-complex-from-mag-ang
1 ]=> (load "80-zero.scm")
;Loading "80-zero.scm"...
; Loading "p125-apply-generic.scm"...
; Loading "p119-tag.scm"... done
; ... done
;... done
;Value: =zero?
1 ]=> (=zero? (make-complex-from-real-imag 0 0))
;Value: #t
1 ]=> (=zero? (make-complex-from-real-imag 10086 10086))
;Value: #f
1 ]=> (=zero? (make-complex-from-mag-ang 0 0))
;Value: #t
1 ]=> (=zero? (make-complex-from-mag-ang 10086 10086))
;Value: #f