source: branches/f4grobner/slow-add.lisp@ 4538

(in-package :polynomial)

(defun f-add (p q order-fn add-fn)
  "Add two polynomials, P and Q, represented as lists of terms.
The operation is destructive to both polynomials, as the terms
of both lists are combined into the result. The operation does not
create any new instance of TERM."
  (do (r)
      ((or (endp p) (endp q))
       ;; NOTE: R contains the result in reverse order. Can it
       ;; be more efficient to produce the terms in correct order?
       (unless (endp q) 
         (setf r (nreconc r q)))
       (unless (endp p)
         (setf r (nreconc r p)))
       r)
    (multiple-value-bind 
          (greater-p equal-p)
        (funcall order-fn (car p) (car q))
      (cond
        (greater-p
         (rotatef (cdr p) r p)
         )
        (equal-p
         (let ((s (funcall add-fn (lc p) (lc q))))
           (cond 
             ((universal-zerop s)
              (setf p (cdr p))
              )
             (t 
              (setf (lc p) s)
              (rotatef (cdr p) r p))))
         (setf q (cdr q))
         )
        (t 
         (rotatef (cdr q) r q))))))

(defun s-add (p q order-fn add-fn &aux result)
  "Non-recursive version of SLOW-ADD. This version uses auxillary variable
RESULT which serves as a stack for the terms of the sum of P and Q."
  (loop 
     (cond
       ((endp p) (return-from s-add (nreconc result q)))
       ((endp q) (return-from s-add (nreconc result p)))
       (t 
        (multiple-value-bind 
              (greater-p equal-p)
            (funcall order-fn (car p) (car q))
          (cond
            (greater-p                  ; (> (car p) (car q))
             (push (pop p) result)
             )
            (equal-p                    ; (= (car p)) (car q))
             (let ((s (funcall add-fn (lc p) (lc q))))
               (cond 
                 ((universal-zerop s)
                  (pop p))
                 (t 
                  ;; Adjust the lc of p
                  (setf (lc p) s)
                  (push (pop p) result)
                  )
                 ))
             (pop q)
             )
            (t      ;(< (car p) (car q))                        
             (push (pop q) result)
             )
            ))))))