]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex2_90.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / ex2_90.rkt
1 #lang racket
2
3 (define (install-dense-termlist-package)
4   ;; internal procedures
5   (define (adjoin-term term term-list) 
6     (cons (coeff term) term-list))
7   (define (first-term term-list)
8     (let ((len (length term-list)))
9       (make-term (- len 1) (car term-list))))
10   (define (rest-terms term-list) (cdr term-list))
11   (define (the-empty-termlist) '())
12   (define (empty-termlist? term-list) (null? term-list))
13   ;; interface to the rest of the system
14   (define (tag x) (attach-tag 'dense x))  
15   (put 'adjoin-term '(term dense)
16        (lambda (term term-list)
17          (tag (adjoin-term term term-list))))
18   (put 'first-term '(dense) first-term)
19   (put 'rest-terms '(dense) 
20        (lambda (term-list) 
21          (tag (rest-terms term-list))))
22   (put 'the-empty-termlist '(dense)
23        (lambda ()
24          (tag (the-empty-termlist))))
25   (put 'empty-termlist? '(dense) 
26        (lambda (tl)
27          (empty-termlist? (contents tl))))
28   'done)
29
30 (define (install-sparse-termlist-package)
31   ;; internal procedures
32   (define (adjoin-term term term-list)
33     (if (=zero? (coeff term))
34         term-list
35         (cons (coeff term) term-list)))
36   (define (first-term term-list) (car term-list))
37   (define (rest-terms term-list) (cdr term-list))
38   (define (the-empty-termlist) '())  
39   (define (empty-termlist? term-list) (null? term-list))
40   
41   ;; interface to the rest of the system
42   (define (tag x) (attach-tag 'sparse x))
43   (put 'adjoin-term '(term sparse) 
44        (lambda (term term-list) 
45          (tag (adjoin-term term term-list))))
46   (put 'first-term '(sparse) first-term)
47   (put 'rest-terms '(sparse) 
48        (lambda (term-list)
49          (tag (rest-terms term-list))))
50   (put 'the-empty-termlist '(sparse)
51        (lambda ()
52          (tag (the-empty-termlist))))
53   (put 'empty-termlist? '(sparse) 
54        (lambda (tl)
55          (empty-termlist? (contents tl))))
56   'done)
57
58 (define (install-term-package)
59   (define (make-term order coeff) (list order coeff))
60   (define (order term) (car term))
61   (define (coeff term) (cadr term))
62   
63   (define (tag x) (attach-tag 'term x))
64   (put 'make-term '(scheme-number scheme-number)
65        (lambda (o c)
66          (tag (make-term o c))))
67   (put 'order '(term) 
68        (lambda (t)
69          (order (contents t))))
70   (put 'coeff '(term)
71        (lambda (t)
72          (coeff (contents t))))
73   'done)
74
75 ;; generic procedures
76 (define (adjoin-term term terms) (apply-generic 'adjoin-term term terms))
77 (define (first-term term-list) (apply-generic 'first-term term-list))
78 (define (rest-terms term-list) (apply-generic 'rest-terms term-list))
79 (define (empty-termlist? tl) (apply-generic 'empty-termlist? tl))
80
81 (define (make-term order coeff) (apply-generic 'make-term order coeff))
82 (define (order term) (apply-generic 'order term))
83 (define (coeff term) (apply-generic 'coeff term))
84
85 #|
86
87 the-empty-termlist needs special treatment because it has no input. This can be remedied
88 by get'ing the right empty term list using:
89
90  (get 'the-empty-termlist '(sparse))
91
92 or 
93
94  (get 'the-empty-termlist '(dense))
95
96 |#