solutions to 2.88, 2.89 and 2.90

diff --git a/src/sicp/ex2_88.rkt b/src/sicp/ex2_88.rkt
new file mode 100644 (file)
index 0000000..55ed370
--- /dev/null
+++ b/src/sicp/ex2_88.rkt
@@ -0,0 +1,43 @@
+#lang racket
+
+(define (negate x) (- x))
+
+(put 'negate '(scheme-number)
+     (lambda (r) (tag (negate r))))
+
+(put 'negate '(rational)
+     (lambda (r) (tag (negate r))))
+
+(put 'negate '(real)
+     (lambda (r) (tag (negate r))))
+
+(put 'negate '(complex)
+     (lambda (c) (tag ((get 'make 'complex) (negate (real c))
+                                            (negate (imag c))))))
+
+(put 'negate '(polynomial)
+     (lambda (p) (tag (negate-poly p))))
+
+(define (negate-terms terms)
+  (if (empty-termlist? terms)
+      the-empty-termlist
+      (let ((t1 (first-term terms)))
+        (let ((o (order t1))
+              (c (coeff t1)))
+          (adjoin-term (make-term o (negate c))
+                       (negate-terms (rest-terms terms)))))))
+
+(define (negate-poly p)
+  (let ((terms (term-list p)))
+    (make-poly (variable p) (negate-terms terms))))
+
+(put 'negate '(polynomial)
+     (lambda (p) (tag (negate-poly p))))
+
+(define (negate p) (apply-generic 'negate p))
+
+(define (sub-poly p1 p2)
+  (add-poly p1 (negate p2)))
+
+(put 'sub '(polynomial polynomial)
+     (lambda (p1 p2) (tag (sub-poly p1 p2))))
\ No newline at end of file

diff --git a/src/sicp/ex2_89.rkt b/src/sicp/ex2_89.rkt
new file mode 100644 (file)
index 0000000..d37a8eb
--- /dev/null
+++ b/src/sicp/ex2_89.rkt
@@ -0,0 +1,17 @@
+#lang racket
+
+(define (adjoin-term term term-list) 
+  (cons (coeff term) term-list))
+
+(define (the-empty-termlist) '())
+
+(define (first-term term-list)
+  (let ((len (length term-list)))
+    (make-term (- len 1) (car term-list))))
+
+(define (rest-terms term-list) (cdr term-list))
+(define (empty-termlist? term-list) (null? term-list))
+
+(define (make-term order coeff) (list order coeff)
+(define (order term) (car term))
+(define (coeff term) (cadr term))
\ No newline at end of file

diff --git a/src/sicp/ex2_90.rkt b/src/sicp/ex2_90.rkt
new file mode 100644 (file)
index 0000000..a3c374c
--- /dev/null
+++ b/src/sicp/ex2_90.rkt
@@ -0,0 +1,96 @@
+#lang racket
+
+(define (install-dense-termlist-package)
+  ;; internal procedures
+  (define (adjoin-term term term-list) 
+    (cons (coeff term) term-list))
+  (define (first-term term-list)
+    (let ((len (length term-list)))
+      (make-term (- len 1) (car term-list))))
+  (define (rest-terms term-list) (cdr term-list))
+  (define (the-empty-termlist) '())
+  (define (empty-termlist? term-list) (null? term-list))
+  ;; interface to the rest of the system
+  (define (tag x) (attach-tag 'dense x))  
+  (put 'adjoin-term '(term dense)
+       (lambda (term term-list)
+         (tag (adjoin-term term term-list))))
+  (put 'first-term '(dense) first-term)
+  (put 'rest-terms '(dense) 
+       (lambda (term-list) 
+         (tag (rest-terms term-list))))
+  (put 'the-empty-termlist '(dense)
+       (lambda ()
+         (tag (the-empty-termlist))))
+  (put 'empty-termlist? '(dense) 
+       (lambda (tl)
+         (empty-termlist? (contents tl))))
+  'done)
+
+(define (install-sparse-termlist-package)
+  ;; internal procedures
+  (define (adjoin-term term term-list)
+    (if (=zero? (coeff term))
+        term-list
+        (cons (coeff term) term-list)))
+  (define (first-term term-list) (car term-list))
+  (define (rest-terms term-list) (cdr term-list))
+  (define (the-empty-termlist) '())  
+  (define (empty-termlist? term-list) (null? term-list))
+  
+  ;; interface to the rest of the system
+  (define (tag x) (attach-tag 'sparse x))
+  (put 'adjoin-term '(term sparse) 
+       (lambda (term term-list) 
+         (tag (adjoin-term term term-list))))
+  (put 'first-term '(sparse) first-term)
+  (put 'rest-terms '(sparse) 
+       (lambda (term-list)
+         (tag (rest-terms term-list))))
+  (put 'the-empty-termlist '(sparse)
+       (lambda ()
+         (tag (the-empty-termlist))))
+  (put 'empty-termlist? '(sparse) 
+       (lambda (tl)
+         (empty-termlist? (contents tl))))
+  'done)
+
+(define (install-term-package)
+  (define (make-term order coeff) (list order coeff))
+  (define (order term) (car term))
+  (define (coeff term) (cadr term))
+  
+  (define (tag x) (attach-tag 'term x))
+  (put 'make-term '(scheme-number scheme-number)
+       (lambda (o c)
+         (tag (make-term o c))))
+  (put 'order '(term) 
+       (lambda (t)
+         (order (contents t))))
+  (put 'coeff '(term)
+       (lambda (t)
+         (coeff (contents t))))
+  'done)
+
+;; generic procedures
+(define (adjoin-term term terms) (apply-generic 'adjoin-term term terms))
+(define (first-term term-list) (apply-generic 'first-term term-list))
+(define (rest-terms term-list) (apply-generic 'rest-terms term-list))
+(define (empty-termlist? tl) (apply-generic 'empty-termlist? tl))
+
+(define (make-term order coeff) (apply-generic 'make-term order coeff))
+(define (order term) (apply-generic 'order term))
+(define (coeff term) (apply-generic 'coeff term))
+
+#|
+
+the-empty-termlist needs special treatment because it has no input. This can be remedied
+by get'ing the right empty term list using:
+
+ (get 'the-empty-termlist '(sparse))
+
+or 
+
+ (get 'the-empty-termlist '(dense))
+
+|#