Changeset 1227 for branches/f4grobner/termlist.lisp
- Timestamp:
- 2015-06-11T13:13:36-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/termlist.lisp
r1201 r1227 122 122 (defun monom-times-termlist (m f) 123 123 (cond 124 ((null f) nil)125 (t126 (mapcar #'(lambda (x) (monom-times-term m x)) f))))124 ((null f) nil) 125 (t 126 (mapcar #'(lambda (x) (monom-times-term m x)) f)))) 127 127 128 128 (defun termlist-uminus (ring f) … … 212 212 ((null tail) head) 213 213 (t (nconc head tail))))))) 214 214 215 215 (defun termlist-unit (ring dim) 216 216 (declare (fixnum dim) (ring ring)) 217 217 (list (make-term (make-monom :dimension dim) (funcall (ring-unit ring))))) 218 218 219 219 220 220 (defun termlist-expt (ring-and-order poly n … … 224 224 (declare (type fixnum n dim) (ring-and-order ring-and-order)) 225 225 (cond 226 ((minusp n) (error "termlist-expt: Negative exponent."))227 ((endp poly) (if (zerop n) (termlist-unit ring dim) nil))228 (t229 (do ((k 1 (ash k 1))230 (q poly (termlist-mul ring-and-order q q)) ;keep squaring231 (p (termlist-unit ring dim) (if (not (zerop (logand k n))) (termlist-mul ring-and-order p q) p)))232 ((> k n) p)233 (declare (fixnum k))))))226 ((minusp n) (error "termlist-expt: Negative exponent.")) 227 ((endp poly) (if (zerop n) (termlist-unit ring dim) nil)) 228 (t 229 (do ((k 1 (ash k 1)) 230 (q poly (termlist-mul ring-and-order q q)) ;keep squaring 231 (p (termlist-unit ring dim) (if (not (zerop (logand k n))) (termlist-mul ring-and-order p q) p))) 232 ((> k n) p) 233 (declare (fixnum k))))))
Note:
See TracChangeset
for help on using the changeset viewer.