Move termlist procedures to separate package

2_78.rkt

@@ -480,8 +480,8 @@
   (define (add-poly p1 p2)
     (if (same-variable? (variable p1) (variable p2))
         (make-poly (variable p1)
-                   (add-terms (term-list p1)
-                              (term-list p2)))
+                   (add (term-list p1)
+                        (term-list p2)))
         (error "Polys not in same var -- ADD-POLY"
                (list p1 p2))))
 
@@ -490,8 +490,8 @@
   (define (mul-poly p1 p2)
     (if (same-variable? (variable p1) (variable p2))
         (make-poly (variable p1)
-                   (mul-terms (term-list p1)
-                              (term-list p2)))
+                   (mul (term-list p1)
+                        (term-list p2)))
         (error "Polys not in same var -- MUL-POLY"
                (list p1 p2))))
 
@@ -506,38 +506,6 @@
           (and (= (coeff (first-term terms)) 0)
                (=zero-poly? (rest-terms terms))))))
 
-  (define (add-terms L1 L2)
-    (cond ((empty-termlist? L1) L2)
-          ((empty-termlist? L2) L1)
-          (else
-           (let ((t1 (first-term L1)) (t2 (first-term L2)))
-             (cond ((> (order t1) (order t2))
-                    (adjoin-term
-                     t1 (add-terms (rest-terms L1) L2)))
-                   ((< (order t1) (order t2))
-                    (adjoin-term
-                     t2 (add-terms L1 (rest-terms L2))))
-                   (else
-                    (adjoin-term
-                     (make-term (order t1)
-                                (add (coeff t1) (coeff t2)))
-                     (add-terms (rest-terms L1)
-                                (rest-terms L2)))))))))
-
-  (define (mul-terms L1 L2)
-    (if (empty-termlist? L1)
-        (the-empty-termlist)
-        (add-terms (mul-term-by-all-terms (first-term L1) L2)
-                   (mul-terms (rest-terms L1) L2))))
-
-  (define (mul-term-by-all-terms t1 L)
-    (if (empty-termlist? L)
-        (the-empty-termlist)
-        (let ((t2 (first-term L)))
-          (adjoin-term
-           (make-term (+ (order t1) (order t2))
-                      (mul (coeff t1) (coeff t2)))
-           (mul-term-by-all-terms t1 (rest-terms L))))))
   ;; interface to rest of the system
   (define (tag p) (attach-tag 'polynomial p))
   (put 'add '(polynomial polynomial) 
@@ -555,6 +523,126 @@
        (lambda (var terms) (tag (make-poly var terms))))
   'done)
 
+(define (install-termlist-package)
+
+  (define (tag l) (attach-tag 'termlist l))
+
+  (define (make-sparse terms)
+    (tag ((get 'make 'sparse) terms)))
+  (define (make-dense terms)
+    (tag ((get 'make 'dense) terms)))
+
+  (define (the-empty-termlist) '())
+  
+  (define (add-terms L1 L2)
+    (cond ((empty-termlist? L1) L2)
+          ((empty-termlist? L2) L1)
+          (else
+           (let ((t1 (first-term L1)) (t2 (first-term L2)))
+             (cond ((> (order t1) (order t2))
+                    (adjoin-term
+                     t1 (add-terms (rest-terms L1) L2)))
+                   ((< (order t1) (order t2))
+                    (adjoin-term
+                     t2 (add-terms L1 (rest-terms L2))))
+                   (else
+                    (adjoin-term
+                     (make-term (order t1)
+                                (add (coeff t1) (coeff t2)))
+                     (add (rest-terms L1)
+                          (rest-terms L2)))))))))
+
+  (define (mul-terms L1 L2)
+    (if (empty-termlist? L1)
+        (the-empty-termlist)
+        (add (mul-term-by-all-terms (first-term L1) L2)
+             (mul (rest-terms L1) L2))))
+
+  (define (mul-term-by-all-terms t1 L)
+    (if (empty-termlist? L)
+        (the-empty-termlist)
+        (let ((t2 (first-term L)))
+          (adjoin-term
+           (make-term (+ (order t1) (order t2))
+                      (mul (coeff t1) (coeff t2)))
+           (mul-term-by-all-terms t1 (rest-terms L))))))
+  
+
+  (put 'add '(termlist termlist)
+       (lambda (L1 L2)
+         (tag (add-terms L1 L2))))
+
+  (put 'mul '(termlist termlist)
+       (lambda (L1 L2)
+         (tag (mul-terms L1 L2))))
+
+  (put 'first-term '(termlist) first-term)
+  (put 'rest-terms '(termlist)
+       (lambda (termlist)
+         (tag (rest-terms termlist))))
+  (put 'empty-termlist? '(termlist) empty-termlist?)
+       
+  (put 'adjoin-term '(term termlist) adjoin-term)
+  
+  (put 'make-sparse-termlist 'termlist
+       make-sparse)
+  (put 'make-dense-termlist 'termlist
+       make-dense)
+
+  (put 'the-empty-termlist 'termlist
+       the-empty-termlist)
+  
+  'done)
+
+(define (install-sparse-package) 
+
+  ;; NB assume that terms are ordered by decreasing term order
+  (define (make-termlist terms)
+    (if (null? terms)
+        (the-empty-termlist)
+        (adjoin-term (car terms)
+                     (make-termlist (cdr terms)))))
+  ;; representation of terms and term lists
+  ;;[procedures adjoin-term ... coeff from text below]
+  (define (adjoin-term term term-list)
+    (if (=zero? (coeff term))
+        term-list
+        (cons (contents term) term-list)))
+
+  (define (the-empty-termlist) '())
+  (define (empty-termlist? term-list) (null? term-list))
+  (define (negate-termlist term-list)
+    (map (lambda (t) (list (car t) (negate (cadr t))))
+         term-list))
+  
+  (define (tag l) (attach-tag 'sparse l))
+
+  (put 'make 'sparse
+       (lambda (terms) (tag (make-termlist terms))))
+  (put 'adjoin-term '(term sparse)
+       (lambda (term termlist)
+        (tag (adjoin-term term termlist))))
+  (put 'empty-termlist? '(sparse) empty-termlist?)
+  (put 'the-empty-termlist '(sparse)
+       (lambda ()
+         (tag (the-empty-termlist))))
+  (put 'first-term '(sparse)
+       (lambda (termlist)
+         (if (pair? termlist)
+             (make-term (caar termlist)
+                        (cadar termlist))
+             (make-term 0 0))))
+  (put 'rest-terms '(sparse)
+       (lambda (termlist)
+         (display termlist)
+         (if (pair? termlist)
+             (tag (cdr termlist))
+             (the-empty-termlist))))
+  (put 'negate '(sparse)
+       (lambda (termlist)
+         (tag (negate-termlist termlist))))
+  'done)
+
 (define (install-term-package)
   (define (make-term order coeff)
     (tag (list order coeff)))
@@ -571,50 +659,6 @@
   'done)
   
 
-(define (install-sparse-package) 
-
-  ;; NB assume that terms are ordered by decreasing term order
-  (define (make-termlist terms)
-    (if (null? terms)
-        (the-empty-termlist)
-        (adjoin-term (contents (car terms))
-                     (make-termlist (cdr terms)))))
-  ;; representation of terms and term lists
-  ;;[procedures adjoin-term ... coeff from text below]
-  (define (adjoin-term term term-list)
-    (if (=zero? (coeff term))
-        term-list
-        (cons term term-list)))
-
-  (define (the-empty-termlist) '())
-  (define (first-term term-list) (car term-list))
-  (define (empty-termlist? term-list) (null? term-list))
-  (define (negate-termlist term-list)
-    (map (lambda (t) (list (car t) (negate (cadr t))))
-         term-list))
-  
-  (define (tag l) (attach-tag 'sparse-termlist l))
-
-  (put 'make 'sparse-termlist
-       (lambda (terms) (tag (make-termlist terms))))
-  (put 'adjoin-term '(term sparse-termlist)
-       (lambda (term termlist)
-        (tag (adjoin-term term termlist))))
-  (put 'empty-termlist? '(sparse-termlist) empty-termlist?)
-  (put 'the-empty-termlist '(sparse-termlist)
-       (lambda ()
-         (tag (the-empty-termlist))))
-  (put 'first-term '(sparse-termlist)
-       (lambda (termlist)
-         (make-term (caar termlist)
-                    (cadar termlist))))
-  (put 'rest-terms '(sparse-termlist)
-       (lambda (termlist)
-         (tag (cdr termlist))))
-  (put 'negate '(sparse-termlist)
-       (lambda (termlist)
-         (tag (negate-termlist termlist))))
-  'done)
 
 ;; Generic constructors
 
@@ -640,7 +684,13 @@
   ((get 'make 'term) order coeff))
 
 (define (make-sparse-termlist sparse-terms)
-  ((get 'make 'sparse-termlist) sparse-terms))
+  ((get 'make-sparse-termlist 'termlist) sparse-terms))
+
+(define (make-dense-termlist dense-terms)
+  ((get 'make-dense-termlist 'termlist) dense-terms))
+
+(define (the-empty-termlist)
+  (get 'the-empty-termlist 'termlist))
 
 ;; Generic selectors
 
@@ -648,12 +698,19 @@
 (define (imag-part z) (apply-generic 'imag-part z))
 (define (magnitude z) (apply-generic 'magnitude z))
 (define (angle z) (apply-generic 'angle z))
+(define (order t) (apply-generic 'order t))
+(define (coeff t) (apply-generic 'coeff t))
 
 (put 'real-part '(complex) real-part)
 (put 'imag-part '(complex) imag-part)
 (put 'magnitude '(complex) magnitude)
 (put 'angle '(complex) angle)
 
+(define (first-term termlist)
+  (apply-generic 'first-term termlist))
+(define (rest-terms termlist)
+  (apply-generic 'rest-terms termlist))
+
 ;; Generic operators
 
 (define (add x y) (apply-generic 'add x y))
@@ -674,15 +731,10 @@
 (define (=zero? x) (apply-generic '=zero? x))
 (define (exp x y) (apply-generic 'exp x y))
 
-;; Generic term-list operators
 (define (adjoin-term term termlist)
   (apply-generic 'adjoin-term term termlist))
-(define (empty-termlist termlist)
+(define (empty-termlist? termlist)
   (apply-generic 'empty-termlist? termlist))
-(define (first-term termlist)
-  (apply-generic 'first-term termlist))
-(define (rest-terms termlist)
-  (apply-generic 'rest-terms termlist))
 
 (define (drop x)
   (and (type-tagged? x)
@@ -712,6 +764,7 @@
 (install-polar-package)
 (install-rectangular-package)
 (install-complex-package)
+(install-termlist-package)
 (install-sparse-package)
 (install-term-package)
 (install-polynomial-package)
@@ -743,8 +796,8 @@
   (length term-list))
 
 (define (make-term-dense order coeff) (list order coeff))
-(define (order term) (car term))
-(define (coeff term) (cadr term))
+(define (order-dense term) (car term))
+(define (coeff-dense term) (cadr term))
 (define first-term-dense car)
 (define (rest-terms-dense term-list)
   (if (pair? term-list)
@@ -756,8 +809,8 @@
          (make-termlist-dense (cdr coeffs)))
         (else (cons (car coeffs)
                     (make-termlist-dense (cdr coeffs))))))
-(define the-empty-termlist '())
-(define empty-termlist? null?)
+(define the-empty-termlist-dense '())
+(define empty-termlist-dense? null?)
 
 (define (adjoin-term-dense term term-list)
   (let ((term-list-order (highest-order-term term-list)))