Changeset 2742 for branches/f4grobner

Timestamp:

2015-06-20T18:54:29-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/polynomial.lisp (modified) (2 diffs)

branches/f4grobner/polynomial.lisp

@@ -102 +102 @@
 
 
-(defmacro fast-add/subtract (order-fn add/subtract-fun 
+(defmacro fast-add/subtract (p q order-fn add/subtract-fun 
                              &optional 
                                (uminus-fun nil uminus-fun-supplied-p))
@@ -109 +109 @@
 terms. This function destroys both arguments, reusing the terms to
 build the result."
-  `(lambda (p q) 
-     (macrolet ((lc (x) `(r-coeff (car ,x))))
-       (do ((p p)
-            (q q)
-            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)))
-            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/subtract-fun (lc p) (lc q))))
-                (cond 
-                  ((r-zerop s)
-                   (setf p (cdr p))
-                   )
-                  (t 
-                   (setf (lc p) s)
-                   (rotatef (cdr p) r p))))
-              (setf q (cdr q))
-              )
-             (t 
-              ;;Negate the term of Q if UMINUS provided
-              ,@(when uminus-fun-supplied-p
-                      `((setf (lc q) (funcall ,uminus-fun (lc q)))))
-              (rotatef (cdr q) r q))))))))
+  `(macrolet ((lc (x) `(r-coeff (car ,x))))
+     (do ((p ,p)
+          (q ,q)
+          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)))
+          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/subtract-fun (lc p) (lc q))))
+              (cond 
+                ((r-zerop s)
+                 (setf p (cdr p))
+                 )
+                (t 
+                 (setf (lc p) s)
+                 (rotatef (cdr p) r p))))
+            (setf q (cdr q))
+            )
+           (t 
+            ;;Negate the term of Q if UMINUS provided
+            ,@(when uminus-fun-supplied-p
+                    `((setf (lc q) (funcall ,uminus-fun (lc q)))))
+            (rotatef (cdr q) r q))))))))