Finish chapter 2 parts 4 and 5

1 files changed, 3 insertions, 245 deletions

diff --git a/chap2/part4.rkt b/chap2/part4.rkt
index 63b64d7..b7c6028 100644
--- a/chap2/part4.rkt
+++ b/chap2/part4.rkt
@@ -13,15 +13,15 @@
 
 ;; Tagged data
 
-(define (attach-tag- type-tag contents)
+(define (attach-tag type-tag contents)
   (cons type-tag contents))
 
-(define (type-tag- datum)
+(define (type-tag datum)
   (if (pair? datum)
     (car datum)
     (error "Bad tagged datum -- TYPE-TAG" datum)))
 
-(define (contents- datum)
+(define (contents datum)
   (if (pair? datum)
     (cdr datum)
     (error "Bad tagged datum -- CONTENTS" datum)))
@@ -348,245 +348,3 @@
 ;; Message passing is ideal if new types must often be added.
 ;; Generic operations with explict dispatch is best if new
 ;; operations must often be added.
-
-(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 (install-scheme-number-package)
-  ;; interface
-  (define (tag x)
-    (attach-tag 'scheme-number x))
-  (put 'add '(scheme-number scheme-number)
-    (lambda (x y) (tag (+ x y))))
-  (put 'sub '(scheme-number scheme-number)
-    (lambda (x y) (tag (- x y))))
-  (put 'mul '(scheme-number scheme-number)
-    (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) (tag (= x y))))
-  (put '=zero? '(scheme-number)
-    (lambda (x) (tag (= x 0))))
-  (put 'make 'scheme-number (lambda (x) (tag x)))
-  'done)
-
-(define (make-scheme-number n)
-  ((get 'make 'scheme-number) n))
-
-(define (install-rational-package)
-  ;; internal procedures
-  (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))))
-  (define (add-rat x y)
-    (make-rat
-      (+
-        (* (numer x) (denom y))
-        (* (numer y) (denom x)))
-      (* (denom x) (denom y))))
-  (define (sub-rat x y)
-    (make-rat
-      (-
-        (* (numer x) (denom y))
-        (* (numer y) (denom x)))
-      (* (denom x) (denom y))))
-  (define (mul-rat x y)
-    (make-rat
-      (* (numer x) (numer y))
-      (* (denom x) (denom y))))
-  (define (div-rat x y)
-    (make-rat
-      (* (numer x) (denom y))
-      (* (denom x) (numer y))))
-  (define (equ?-rat x y)
-    (=
-      (* (numer x) (denom y))
-      (* (denom x) (numer y))))
-  (define (=zero?-rat x)
-    (= (numer x) 0))
-  ;; interface
-  (define (tag x) (attach-tag 'rational x))
-  (put 'add '(rational rational)
-    (lambda (x y) (tag (add-rat x y))))
-  (put 'sub '(rational rational)
-    (lambda (x y) (tag (sub-rat x y))))
-  (put 'mul '(rational rational)
-    (lambda (x y) (tag (mul-rat x y))))
-  (put 'div '(rational rational)
-    (lambda (x y) (tag (div-rat x y))))
-  (put 'equ? '(rational rational)
-    (lambda (x y) (tag (equ?-rat x y))))
-  (put '=zero? '(rational)
-    (lambda (x) (tag (=zero?-rat x))))
-  (put 'make 'rational
-    (lambda (n d) (tag (make-rat n d))))
-  'done)
-
-(define (make-rational n d)
-  ((get 'make 'rational) n d))
-
-(define (install-complex-package)
-  ;; imported procedures
-  (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))))
-  (define (equ?-complex z1 z2)
-    (and
-      (= (real-part z1) (real-part z2))
-      (= (imag-part z1) (imag-part z2))))
-  (define (=zero?-complex z)
-    (and
-      (= (real-part z) 0)
-      (= (imag-part z) 0)))
-  ;; interface
-  (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 'equ? '(complex complex)
-    (lambda (z1 z2) (tag (equ?-complex z1 z2))))
-  (put '=zero? '(complex)
-    (lambda (z) (tag (=zero?-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))))
-  (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))
-
-#| 2.77 |#
-
-;; (define z (make-complex-from-real-imag 3 4))
-
-;; (magnitude z)
-
-;; (magnitude '(complex rectangular (3 . 4)))
-
-;; (apply-generic 'magnitude '(complex rectangular (3 . 4)))
-
-;; ((get 'magnitude 'complex) '(rectangular (3 . 4)))
-
-;; (magnitude '(rectangular (3 . 4)))
-
-;; (apply-generic 'magnitude '(rectangular (3 . 4)))
-
-;; ((get 'magnitude 'rectangular) '(3 . 4))
-
-;; ((lambda (z) (sqrt (+ (square (real-part z)) (square (imag-part z))))) '(3 . 4))
-
-;; (sqrt (+ (square 3) (square 4)))
-
-;; 5
-
-#| 2.78 |#
-
-(define (attach-tag type-tag contents)
-  (if (eq? type-tag 'scheme-number)
-    contents
-    (cons type-tag contents)))
-
-(define (type-tag datum)
-  (cond
-    ((pair? datum) (car datum))
-    ((number? datum) 'scheme-number)
-    (error "Bad tagged datum -- TYPE-TAG" datum)))
-
-(define (contents datum)
-  (cond
-    ((pair? datum) (cdr datum))
-    ((number? datum) datum)
-    (error "Bad tagged datum -- CONTENTS" datum)))
-
-#| 2.79 |#
-
-(define (equ? x y) (apply-generic 'equ? x y))
-
-;; Add to scheme-number package:
-
-  #| (put 'equ? '(scheme-number scheme-number) |#
-  #|   (lambda (x y) (tag (= x y)))) |#
-
-;; Add to rational package:
-
-  #| (define (equ?-rat x y) |#
-  #|   (= |#
-  #|     (* (numer x) (denom y)) |#
-  #|     (* (denom x) (numer y)))) |#
-
-
-  #| (put 'equ? '(rational rational) |#
-  #|   (lambda (x y) (tag (equ?-rat x y)))) |#
-
-;; Add to complex package:
-
-  #| (define (equ?-complex z1 z2) |#
-  #|   (and |#
-  #|     (= (real-part z1) (real-part z2)) |#
-  #|     (= (imag-part z1) (imag-part z2)))) |#
-
-  #| (put 'equ? '(complex complex) |#
-  #|   (lambda (z1 z2) (tag (equ?-complex z1 z2)))) |#
-
-#| 2.80 |#
-
-(define (=zero? x) (apply-generic '=zero? x))
-
-;; Add to scheme-number package:
-
-  #| (put '=zero? '(scheme-number) |#
-  #|   (lambda (x) (tag (= x 0)))) |#
-
-;; Add to rational package:
-
-  #| (define (=zero?-rat x) |#
-  #|   (= (numer x) 0)) |#
-
-  #| (put '=zero? '(rational) |#
-  #|   (lambda (x) (tag (=zero?-rat x)))) |#
-
-;; Add to complex package:
-
-  #| (define (=zero?-complex z) |#
-  #|   (and |#
-  #|     (= (real-part z) 0) |#
-  #|     (= (imag-part z) 0))) |#
-
-  #| (put '=zero? '(complex) |#
-  #|   (lambda (z) (tag (=zero?-complex z)))) |#