close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

Changeset 2655


Ignore:
Timestamp:
2015-06-20T15:31:23-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/polynomial.lisp

    r2654 r2655  
    9797
    9898(defun fast-addition (p q order-fn add-fun)
    99   (macrolet ((lt (x) `(car ,x))
    100              (lc (x) `(r-coeff (car ,x))))
     99  (macrolet ((lc (x) `(r-coeff (car ,x))))
    101100    (do ((p p)
    102          (q q))
    103         ((and (endp p) (endp q)))
     101         (q q)
     102         r)
     103        ((cond
     104           ((endp q))
     105           ((endp p)
     106            (setf (cdr r) q)
     107            t))
     108         (nreconc r q))
    104109      (multiple-value-bind
    105110            (greater-p equal-p)
    106           (funcall order-fn (lt q) (lt p))
     111          (funcall order-fn (car p) (car q))
    107112        (cond
    108113          (greater-p
    109            (rotatef (cdr p) (cdr q)))
     114           (psetf (cdr p) r
     115                  r p
     116                  p (cdr p))
     117           )
    110118          (equal-p
    111119           (let ((s (funcall add-fun (lc p) (lc q))))
    112              (if (r-zerop s)
    113                  (setf (cdr p) (cddr p)
    114                        q (cdr q))
    115                  (setf (lc p) s
    116                        q (cdr q)))))))
    117       (setf p (cdr p)))))
     120             (unless (r-zerop s)
     121               (setf (lc p) s)
     122               (psetf p (cdr p)
     123                      (cdr p) r
     124                      r p)))
     125           (setf q (cdr q))
     126           )
     127          (t
     128           (psetf q (cdr q)
     129                  (cdr q) r
     130                  r q)))))))
     131
     132
    118133
    119134(defmacro def-additive-operation-method (method-name &optional (doc-string nil doc-string-supplied-p))
Note: See TracChangeset for help on using the changeset viewer.