Implement till 2.80

ex-2_77-97.scm

@@ -40,6 +40,10 @@
        (lambda (x y) (tag (* x y))))
   (put 'div '(scheme-number scheme-number)
        (lambda (x y) (tag (/ x y))))
+  (put 'equ? '(scheme-number scheme-number)
+       (lambda (x y) (= x y)))
+  (put '=zero? '(scheme-number)
+       (lambda (x) (= x 0)))
   (put 'make 'scheme-number
        (lambda (x) (tag x)))
   (display "[install-scheme-number-package]\n")
@@ -66,6 +70,9 @@
   (define (div-rat x y)
     (make-rat (* (numer x) (denom y))
               (* (denom x) (numer y))))
+  (define (equ? x y)
+    (= (* (numer x) (denom y))
+       (* (numer y) (denom x))))
   ;; interface to rest of the system
   (define (tag x) (attach-tag 'rational x))
   (put 'add '(rational rational)
@@ -76,7 +83,9 @@
        (lambda (x y) (tag (mul-rat x y))))
   (put 'div '(rational rational)
        (lambda (x y) (tag (div-rat x y))))
-
+  (put 'equ? '(rational rational) equ?)
+  (put '=zero? '(rational)
+       (lambda (x) (= (numer x) 0)))
   (put 'make 'rational
        (lambda (n d) (tag (make-rat n d))))
   (display "[install-rational-package]\n")
@@ -101,6 +110,7 @@
   (put 'imag-part '(rectangular) imag-part)
   (put 'magnitude '(rectangular) magnitude)
   (put 'angle '(rectangular) angle)
+  (put '=zero? '(rectangular) (lambda (z) (= (real-part z) (imag-part z) 0)))
   (put 'make-from-mag-ang 'rectangular make-from-mag-ang)
   (put 'make-from-real-imag 'rectangular make-from-real-imag)
   (display "[install-rectangular-package]\n")
@@ -123,6 +133,7 @@
   (put 'imag-part '(polar) imag-part)
   (put 'magnitude '(polar) magnitude)
   (put 'angle '(polar) angle)
+  (put '=zero? '(polar) (lambda (z) (= (magnitude z) 0)))
   (put 'make-from-mag-ang 'polar make-from-mag-ang)
   (put 'make-from-real-imag 'polar make-from-real-imag)
   (display "[install-polar-package]\n")
@@ -152,6 +163,9 @@
   (define (div-complex z1 z2)
     (make-from-mag-ang (/ (magnitude z1) (magnitude z2))
                        (- (angle z1) (angle z2))))
+  (define (equ? z1 z2)
+    (and (= (magnitude z1) (magnitude z2))
+         (= (angle z1) (angle z2))))
   ;; interface to rest of the system
   (put 'real-part '(complex) real-part)
   (put 'imag-part '(complex) imag-part)
@@ -170,6 +184,8 @@
        (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 'equ? '(complex complex) equ?)
+  (put '=zero? '(complex) =zero?)
   (display "[install-complex-package]\n")
   'done)
 
@@ -186,11 +202,18 @@
 (define (make-complex-from-mag-ang r a)
   ((get 'make-from-mag-ang 'complex) r a))
 
+(define (real-part z) ((get 'real-part '(complex)) z))
+(define (imag-part z) ((get 'imag-part '(complex)) z))
+(define (magnitude z) ((get 'magnitude '(complex)) z))
+(define (angle z) ((get 'angle '(complex)) z))
+
 ;; generic operations
 (define (add x y) (apply-generic 'add x y))
 (define (sub x y) (apply-generic 'sub x y))
 (define (mul x y) (apply-generic 'mul x y))
 (define (div x y) (apply-generic 'div x y))
+(define (equ? x y) (apply-generic 'equ? x y))
+(define (=zero? x) (apply-generic '=zero? x))
 
 (install-scheme-number-package)
 (install-rational-package)
@@ -199,7 +222,7 @@
 (install-complex-package)
 
 (assert (add (make-scheme-number 10) (make-scheme-number 20)) (make-scheme-number 30))
-(define p1 (make-complex-from-mag-ang 14.142 0.7853))
+(define p1 (make-complex-from-mag-ang 14.142135623730951 0.7853981633974483))
 (define e1 (make-complex-from-real-imag 10 10))
 (assert (add e1 e1) (make-complex-from-real-imag 20 20))
 
@@ -218,5 +241,21 @@
 
 (newline) (display "ex-2.79 - equ?") (newline)
 
+; Extended each of the packages and defined generic procedure
+(assert (equ? (make-scheme-number 10) (make-scheme-number 10)) #t)
+(assert (equ? (make-rational 3 4) (make-rational 6 8)) #t)
+(assert (equ? (make-complex-from-mag-ang 3 4) (make-complex-from-real-imag 6 8)) #f)
+(assert (equ? p1 e1) #t) ; define above
 
 (newline) (display "ex-2.80 - =zero?") (newline)
+
+; Extended each of the packages and defined generic procedure
+(assert (=zero? 0) #t)
+(assert (=zero? 1) #f)
+(assert (=zero? (make-rational 0 1)) #t)
+(assert (=zero? (make-rational 1 1)) #f)
+(assert (=zero? e1) #f)
+(assert (=zero? p1) #f)
+
+(newline) (display "ex-2.81") (newline)
+