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 |#