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 2566


Ignore:
Timestamp:
2015-06-19T17:31:46-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/polynomial.lisp

    r2565 r2566  
    8787
    8888(defmethod add-to ((self poly) (other poly))
     89  "Adds to polynomial SELF another polynomial OTHER.
     90This operation destructively modifies both polynomials.
     91The result is stored in SELF. This implementation does
     92no consing, entirely reusing the sells of SELF and OTHER."
    8993  (macrolet ((lt (termlist) `(car ,termlist))
    9094             (lc (termlist) `(r-coeff (car ,termlist))))
     
    96100             (q termlist2))
    97101            ((endp q))
    98           ;; Copy all initial terms of q greater than (lt p) into p       
    99           (do ()
    100               ((cond
    101                  ((endp q))
    102                  (t
    103                   (multiple-value-bind
    104                         (greater-p equal-p)
    105                       (lex> (lt q) (lt p))
    106                     (cond
    107                       (greater-p
    108                        (psetf (cdr q) p
    109                               q (cdr q)
    110                               (cdr p) p))
    111                       (equal-p
    112                        (setf (lc p) (add-to (lc p) (lc q))
    113                              p (cdr p))))
    114                     (not greater-p))))))))))
     102          (multiple-value-bind
     103                (greater-p equal-p)
     104              (lex> (lt q) (lt p))
     105            (cond
     106              (greater-p
     107               (psetf (cdr q) p
     108                      q (cdr q)
     109                      (cdr p) p))
     110              (equal-p
     111               (setf (lc p) (add-to (lc p) (lc q))
     112                     p (cdr p)
     113                     q (cdr q))))
     114            (not greater-p))))))
    115115  self)
    116116
Note: See TracChangeset for help on using the changeset viewer.