Changeset 2742
- Timestamp:
- 2015-06-20T18:54:29-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/polynomial.lisp
r2741 r2742 102 102 103 103 104 (defmacro fast-add/subtract ( order-fn add/subtract-fun104 (defmacro fast-add/subtract (p q order-fn add/subtract-fun 105 105 &optional 106 106 (uminus-fun nil uminus-fun-supplied-p)) … … 109 109 terms. This function destroys both arguments, reusing the terms to 110 110 build the result." 111 `(lambda (p q) 112 (macrolet ((lc (x) `(r-coeff (car ,x)))) 113 (do ((p p) 114 (q q) 115 r) 116 ((or (endp p) (endp q)) 117 ;; NOTE: R contains the result in reverse order. Can it 118 ;; be more efficient to produce the terms in correct order? 119 (unless (endp q) (setf r (nreconc r q))) 120 r) 121 (multiple-value-bind 122 (greater-p equal-p) 123 (funcall ,order-fn (car p) (car q)) 124 (cond 125 (greater-p 126 (rotatef (cdr p) r p) 127 ) 128 (equal-p 129 (let ((s (funcall ,add/subtract-fun (lc p) (lc q)))) 130 (cond 131 ((r-zerop s) 132 (setf p (cdr p)) 133 ) 134 (t 135 (setf (lc p) s) 136 (rotatef (cdr p) r p)))) 137 (setf q (cdr q)) 138 ) 139 (t 140 ;;Negate the term of Q if UMINUS provided 141 ,@(when uminus-fun-supplied-p 142 `((setf (lc q) (funcall ,uminus-fun (lc q))))) 143 (rotatef (cdr q) r q)))))))) 111 `(macrolet ((lc (x) `(r-coeff (car ,x)))) 112 (do ((p ,p) 113 (q ,q) 114 r) 115 ((or (endp p) (endp q)) 116 ;; NOTE: R contains the result in reverse order. Can it 117 ;; be more efficient to produce the terms in correct order? 118 (unless (endp q) (setf r (nreconc r q))) 119 r) 120 (multiple-value-bind 121 (greater-p equal-p) 122 (funcall ,order-fn (car p) (car q)) 123 (cond 124 (greater-p 125 (rotatef (cdr p) r p) 126 ) 127 (equal-p 128 (let ((s (funcall ,add/subtract-fun (lc p) (lc q)))) 129 (cond 130 ((r-zerop s) 131 (setf p (cdr p)) 132 ) 133 (t 134 (setf (lc p) s) 135 (rotatef (cdr p) r p)))) 136 (setf q (cdr q)) 137 ) 138 (t 139 ;;Negate the term of Q if UMINUS provided 140 ,@(when uminus-fun-supplied-p 141 `((setf (lc q) (funcall ,uminus-fun (lc q))))) 142 (rotatef (cdr q) r q)))))))) 144 143 145 144
Note:
See TracChangeset
for help on using the changeset viewer.