Changeset 2655 for branches

Timestamp:

2015-06-20T15:31:23-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/polynomial.lisp (modified) (1 diff)

branches/f4grobner/polynomial.lisp

@@ -97 +97 @@
 
 (defun fast-addition (p q order-fn add-fun)
-  (macrolet ((lt (x) `(car ,x))
-             (lc (x) `(r-coeff (car ,x))))
+  (macrolet ((lc (x) `(r-coeff (car ,x))))
     (do ((p p)
-         (q q))
-        ((and (endp p) (endp q)))
+         (q q)
+         r)
+        ((cond 
+           ((endp q))
+           ((endp p) 
+            (setf (cdr r) q)
+            t))
+         (nreconc r q))
       (multiple-value-bind 
             (greater-p equal-p)
-          (funcall order-fn (lt q) (lt p))
+          (funcall order-fn (car p) (car q))
         (cond
           (greater-p
-           (rotatef (cdr p) (cdr q)))
+           (psetf (cdr p) r
+                  r p
+                  p (cdr p))
+           )
           (equal-p
            (let ((s (funcall add-fun (lc p) (lc q))))
-             (if (r-zerop s)
-                 (setf (cdr p) (cddr p)
-                       q (cdr q))
-                 (setf (lc p) s
-                       q (cdr q)))))))
-      (setf p (cdr p)))))
+             (unless (r-zerop s)
+               (setf (lc p) s)
+               (psetf p (cdr p)
+                      (cdr p) r
+                      r p)))
+           (setf q (cdr q))
+           )
+          (t 
+           (psetf q (cdr q)
+                  (cdr q) r
+                  r q)))))))
+
+
 
 (defmacro def-additive-operation-method (method-name &optional (doc-string nil doc-string-supplied-p))