Basic structure for generic termlists and terms

Need to check that polynomials behave as expected and also need to add
dense termlists.

2_78.rkt

@@ -475,21 +475,36 @@
   (define (same-variable? v1 v2)
     (and (variable? v1) (variable? v2) (eq? v1 v2)))
 
-  ;; 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 (add-poly p1 p2) ... )
+  ;;[procedures used by add-poly]
+  (define (add-poly p1 p2)
+    (if (same-variable? (variable p1) (variable p2))
+        (make-poly (variable p1)
+                   (add-terms (term-list p1)
+                              (term-list p2)))
+        (error "Polys not in same var -- ADD-POLY"
+               (list p1 p2))))
 
-  (define (the-empty-termlist) '())
-  (define (first-term term-list) (car term-list))
-  (define (rest-terms term-list) (cdr term-list))
-  (define (empty-termlist? term-list) (null? term-list))
+  ;;(define (mul-poly p1 p2) ... )
+  ;;[procedures used by mul-poly]
+  (define (mul-poly p1 p2)
+    (if (same-variable? (variable p1) (variable p2))
+        (make-poly (variable p1)
+                   (mul-terms (term-list p1)
+                              (term-list p2)))
+        (error "Polys not in same var -- MUL-POLY"
+               (list p1 p2))))
 
-  (define (make-term order coeff) (list order coeff))
-  (define (order term) (car term))
-  (define (coeff term) (cadr term))
+  (define (negate-poly p)
+    (make-poly (variable p)
+               (negate (term-list p))))
+    
+  (define (=zero-poly? p)
+    (let ((terms (term-list p)))
+      (if (null? terms)
+          #t
+          (and (= (coeff (first-term terms)) 0)
+               (=zero-poly? (rest-terms terms))))))
 
   (define (add-terms L1 L2)
     (cond ((empty-termlist? L1) L2)
@@ -523,41 +538,6 @@
            (make-term (+ (order t1) (order t2))
                       (mul (coeff t1) (coeff t2)))
            (mul-term-by-all-terms t1 (rest-terms L))))))
-
-  ;;(define (add-poly p1 p2) ... )
-  ;;[procedures used by add-poly]
-  (define (add-poly p1 p2)
-    (if (same-variable? (variable p1) (variable p2))
-        (make-poly (variable p1)
-                   (add-terms (term-list p1)
-                              (term-list p2)))
-        (error "Polys not in same var -- ADD-POLY"
-               (list p1 p2))))
-
-  ;;(define (mul-poly p1 p2) ... )
-  ;;[procedures used by mul-poly]
-  (define (mul-poly p1 p2)
-    (if (same-variable? (variable p1) (variable p2))
-        (make-poly (variable p1)
-                   (mul-terms (term-list p1)
-                              (term-list p2)))
-        (error "Polys not in same var -- MUL-POLY"
-               (list p1 p2))))
-
-  (define (negate-poly p)
-    (define (negate-term term)
-      (make-term (order term)
-                 (negate (coeff term))))
-    (make-poly (variable p)
-               (map negate-term (term-list p))))
-    
-  (define (=zero-poly? p)
-    (let ((terms (term-list p)))
-      (if (null? terms)
-          #t
-          (and (= (coeff (first-term terms)) 0)
-               (=zero-poly? (rest-terms terms))))))
-
   ;; interface to rest of the system
   (define (tag p) (attach-tag 'polynomial p))
   (put 'add '(polynomial polynomial) 
@@ -567,7 +547,7 @@
   (put 'mul '(polynomial polynomial) 
        (lambda (p1 p2) (tag (mul-poly p1 p2))))
   (put 'negate '(polynomial)
-       (lambda (p) (tag (negate-poly p))))
+       (lambda (p) (tag (negate-poly))))
   (put '=zero? '(polynomial)
        (lambda (p) (empty-termlist? (term-list p))))
 
@@ -575,6 +555,67 @@
        (lambda (var terms) (tag (make-poly var terms))))
   'done)
 
+(define (install-term-package)
+  (define (make-term order coeff)
+    (tag (list order coeff)))
+  (define (negate-term term)
+    (make-term (order term)
+               (negate (coeff term))))
+
+  (define (tag t) (attach-tag 'term t))
+
+  (put 'make 'term make-term)
+  (put 'order '(term) car)
+  (put 'coeff '(term) cadr)
+  (put 'negate '(term) negate-term)
+  '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
 
 (define (make-scheme-number n)
@@ -595,6 +636,12 @@
 (define (make-polynomial var terms)
   ((get 'make 'polynomial) var terms))
 
+(define (make-term order coeff)
+  ((get 'make 'term) order coeff))
+
+(define (make-sparse-termlist sparse-terms)
+  ((get 'make 'sparse-termlist) sparse-terms))
+
 ;; Generic selectors
 
 (define (real-part z) (apply-generic 'real-part z))
@@ -627,6 +674,15 @@
 (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)
+  (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)
@@ -656,6 +712,8 @@
 (install-polar-package)
 (install-rectangular-package)
 (install-complex-package)
+(install-sparse-package)
+(install-term-package)
 (install-polynomial-package)
 
 
@@ -684,20 +742,20 @@
 (define (highest-order-term term-list)
   (length term-list))
 
-(define (make-term order coeff) (list order coeff))
+(define (make-term-dense order coeff) (list order coeff))
 (define (order term) (car term))
 (define (coeff term) (cadr term))
-(define first-term car)
-(define (rest-terms term-list)
+(define first-term-dense car)
+(define (rest-terms-dense term-list)
   (if (pair? term-list)
       (cdr term-list)
       the-empty-termlist))
-(define (make-termlist coeffs)
+(define (make-termlist-dense coeffs)
   (cond ((null? coeffs) '())
         ((= 0 (car coeffs))
-         (make-termlist (cdr coeffs)))
+         (make-termlist-dense (cdr coeffs)))
         (else (cons (car coeffs)
-                    (make-termlist (cdr coeffs))))))
+                    (make-termlist-dense (cdr coeffs))))))
 (define the-empty-termlist '())
 (define empty-termlist? null?)
 
@@ -705,17 +763,17 @@
   (let ((term-list-order (highest-order-term term-list)))
     (cond ((and (= (order term) 1)
                 (= term-list-order 0))
-           (make-termlist (list (coeff term))))
+           (make-termlist-dense (list (coeff term))))
           ((= (order term) term-list-order)
-           (make-termlist
+           (make-termlist-dense
             (cons (add (coeff term)
                        (first-term term-list))
                   (rest-terms term-list))))
           ((> (order term) term-list-order)
-           (make-termlist
+           (make-termlist-dense
             (cons (coeff term)
                   (adjoin-term-dense
-                   (make-term (- (order term) 1) 0)
+                   (make-term-dense (- (order term) 1) 0)
                    term-list))))
           (else (adjoin-term-dense term (rest-terms term-list))))))