Changeset 2085

Timestamp:

2015-06-17T19:40:55-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/monom.lisp (modified) (1 diff)

branches/f4grobner/monom.lisp

@@ -260 +260 @@
     (plusp (elt exponents k))))
 
-(defmacro monom-map (fun m &rest ml &aux (result `(copy-seq ,m)))
-  "Map function FUN of one argument over the powers of a monomial M.
-Fun should map a single FIXNUM argument to FIXNUM.  Return a sequence
-of results."
-  `(map-into ,result ,fun ,m ,@ml))
-
-(defun monom-append (m1 m2 &aux (dim (+ (length m1) (length m2))))
-  (declare (type monom m1 m2) (fixnum dim))
-  (concatenate `(monom ,dim) m1 m2))
-
-(defun monom-contract (m k)
+(defmethod tensor-mul ((m1 monom) (m2 monom)
+                       &aux (dim (+ (dimension m1) (dimension m2))))
+  (declare (fixnum dim))
+  (make-instance 'monom :dim dim
+                 :exponents (concatenate 'vector exponents1 exponents2)))
+
+(defmethod contract ((m monom) k)
   "Drop the first K variables in monomial M."
-  (declare (type monom m) (fixnum k))
-  (subseq m k))
+  (declare (fixnum k))
+  (with-slots (dim exponents) 
+      m
+    (setf dim (- dim k)
+          exponents (subseq exponents k))))
 
 (defun make-monom-variable (nvars pos &optional (power 1)