Index: branches/f4grobner/.junk/5am-term.lisp
===================================================================
--- branches/f4grobner/.junk/5am-term.lisp	(revision 3731)
+++ branches/f4grobner/.junk/5am-term.lisp	(revision 3731)
@@ -0,0 +1,187 @@
+;;; -*-  Mode: Lisp -*- 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;                                                                              
+;;;  Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>		 
+;;;  		       								 
+;;;  This program is free software; you can redistribute it and/or modify	 
+;;;  it under the terms of the GNU General Public License as published by	 
+;;;  the Free Software Foundation; either version 2 of the License, or		 
+;;;  (at your option) any later version.					 
+;;; 		       								 
+;;;  This program is distributed in the hope that it will be useful,		 
+;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of		 
+;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the		 
+;;;  GNU General Public License for more details.				 
+;;; 		       								 
+;;;  You should have received a copy of the GNU General Public License		 
+;;;  along with this program; if not, write to the Free Software 		 
+;;;  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.	 
+;;;										 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Run tests using 5am unit testing framework
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; We assume that QuickLisp package manager is installed.
+;; See :
+;;      https://www.quicklisp.org/beta/
+;;
+
+;; The following is unnecessary after running:
+;; * (ql:add-to-init-file)
+;; at lisp prompt:
+;;(load "~/quicklisp/setup")
+
+(ql:quickload :fiveam)
+
+(require :ring "ring")
+(require :monom "monom")
+(require :term "term")
+(require :order "order")
+
+(defpackage #:5am-monom
+  (:use :cl :it.bese.fiveam :ring :monom :term :order)
+  (:documentation "Monom and derived classes tests"))
+
+(in-package :5am-monom)
+
+(def-suite monom-suite 
+    :description "Monom package suite")
+
+(in-suite monom-suite)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;        MONOM class tests
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def-fixture monom-context ()
+  ;; Use SYMBOL-MACROLET not let to avoid 'unused variable' complaints
+  (symbol-macrolet 
+      ((m (make-instance 'monom  :exponents '(1 2 3)))
+       (n (make-instance 'monom  :exponents '(4 5 6)))
+       (m*n (make-instance 'monom  :exponents '(5 7 9)))
+       (n/m (make-instance 'monom  :exponents '(3 3 3)))
+       (m-tensor-n (make-instance 'monom  :exponents '(1 2 3 4 5 6))))
+    (&body)))
+
+(test monom-basics
+  "Monom basics"
+  (with-fixture monom-context () 
+    (is (= (r-dimension m) 3))
+    (is (= (r-elt m 2) 3))
+    (is (= (r-total-degree m) 6))
+    (is (= (r-sugar m) 6))
+    (is (equalp  (r->list (make-instance 'monom  :dimension 3)) '(0 0 0)) "Trivial monomial is a vector of 0's")
+    (is (r-equalp (r* m n) m*n))
+    (is (r-equalp (r/ n m) n/m))
+    (is (r-equalp (right-tensor-product-by m n) m-tensor-n))
+    (signals
+	(error "EXPONENTS must have length DIMENSION") 
+      (make-instance 'monom  :dimension 3 :exponents '(1 2 3 4 5 6)))
+    (is-true (r-divides-p m n))
+    (is-false (r-divides-p n m))
+    (is (r-equalp (r-gcd m n) m))
+    (is (r-equalp (r-lcm m n) n))
+    (is-true (r-depends-p m 0))
+    (signals
+	(error "Index out of bounds")
+      (r-depends-p m 3))
+    )
+  (with-fixture monom-context ()
+    (is (r-equalp (multiply-by m n) m*n)))
+  (with-fixture monom-context ()
+    (is (r-equalp (divide-by n m) n/m))))
+  
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;        TERM class tests
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def-fixture term-context ()
+  (symbol-macrolet 
+      ((z (make-instance 'term  :dimension 3 :coeff 5))
+       (m (make-instance 'term  :dimension 3 :exponents '(1 2 3) :coeff 6))
+       (n (make-instance 'term  :dimension 3 :exponents '(4 5 6) :coeff 12))
+       (m*n (make-instance 'term  :dimension 3 :exponents '(5 7 9) :coeff 72))
+       (n/m (make-instance 'term  :dimension 3 :exponents '(3 3 3) :coeff 2))
+       (m-tensor-n (make-instance 'term  :exponents '(1 2 3 4 5 6) :coeff 72))
+       (m-uminus (make-instance 'term  :dimension 3 :exponents '(1 2 3) :coeff -6)))
+    (&body)))
+
+(test term-basics
+  "Term basics"
+  (with-fixture term-context () 
+    (is (= (r-dimension m) 3))
+    (is (= (r-elt m 2) 3))
+    (is (= (r-total-degree m) 6))
+    (is (= (r-sugar m) 6))
+    (is (equalp  (r->list z) '(0 0 0)) "Trivial term is a vector of 0's")
+    (is (r-equalp (r* m n) m*n))
+    (is (r-equalp (r/ n m) n/m))
+    (is (r-equalp (right-tensor-product-by m n) m-tensor-n))
+    (signals
+	(error "EXPONENTS must have length DIMENSION") 
+      (make-instance 'term  :dimension 3 :exponents '(1 2 3 4 5 6) :coeff 77))
+    (is-true (r-divides-p m n))
+    (is-false (r-divides-p n m))
+    (is (r-equalp (r-gcd m n) m))
+    (is (r-equalp (r-lcm m n) n))
+    (is-true (r-depends-p m 0))
+    (signals
+	(error "Index out of bounds")
+      (r-depends-p m 3))
+    )
+  (with-fixture term-context ()
+    (is (r-equalp (multiply-by m n) m*n)))
+  (with-fixture term-context ()
+    (is (r-equalp (divide-by n m) n/m)))
+  (with-fixture term-context ()
+    (is (r-equalp (unary-minus m) m-uminus))))
+
+
+(def-fixture monom/term-conversion-context ()
+  (symbol-macrolet 
+      ((term (make-instance 'term :exponents '(1 2 3) :coeff 4))
+       (monom (make-instance 'monom :exponents '(1 2 3)))
+       (promoted-monom  (make-instance 'term :exponents '(1 2 3) :coeff 1)))
+    (&body)))
+
+(test monom/term-conversion
+  "Monom/term conversion"
+  (with-fixture monom/term-conversion-context ()
+    (is (r-equalp (change-class term 'monom) monom)))
+  (with-fixture monom/term-conversion-context ()
+    (is (r-equalp (change-class monom 'term) promoted-monom))))
+
+(test monom/term-copy
+  "Monom/term copy"
+  (with-fixture monom/term-conversion-context ()
+    (is (r-equalp (copy-instance monom) monom))
+    (is (r-equalp (copy-instance term) term)))
+  )
+
+(test term-tensor-product
+  "Term tensor product"
+  (let ((term1 (make-instance 'term :exponents '(1 2 3) :coeff 4))
+	(term2 (make-instance 'term :exponents '(4 5) :coeff 3))
+	(term1-left-tensor-by-term2 (make-instance 'term :exponents '(4 5 1 2 3) :coeff 12)))
+    (is (r-equalp (left-tensor-product-by term1 term2) term1-left-tensor-by-term2))))
+
+(test term-contract
+  "Term contract"
+  (let ((term (make-instance 'term :exponents '(1 2 3) :coeff 4))
+	(term-contracted (make-instance 'term :exponents '(2 3) :coeff 4)))
+    (is (r-equalp (left-contract term 1) term-contracted))))
+
+
+
+(run! 'monom-suite)
+(format t "All tests done!~%")
+
+
Index: branches/f4grobner/.junk/monomial.lisp
===================================================================
--- branches/f4grobner/.junk/monomial.lisp	(revision 3488)
+++ branches/f4grobner/.junk/monomial.lisp	(revision 3731)
@@ -204,2 +204,69 @@
   "A human-readable representation of a monomial M as a list of exponents."  
   (coerce m 'list))
+
+(defclass term (monom)
+  ()
+  (:documentation "Implements a term, i.e. a product of a scalar
+and powers of some variables, such as 5*X^2*Y^3."))
+
+(defmethod print-object ((self term) stream)
+  (print-unreadable-object (self stream :type t :identity t)
+    (with-accessors ((exponents monom-exponents)
+		     (coeff scalar-coeff))
+	self
+      (format stream "EXPONENTS=~A COEFF=~A"
+	      exponents coeff))))
+
+
+(defmethod r-equalp ((term1 term) (term2 term))
+  (when (r-equalp (scalar-coeff term1) (scalar-coeff term2))
+    (call-next-method)))
+
+(defmethod update-instance-for-different-class :after ((old monom) (new  scalar) &key)
+  (setf (scalar-coeff new) 1))
+
+(defmethod multiply-by :before ((self term) (other term))
+  "Destructively multiply terms SELF and OTHER and store the result into SELF.
+It returns SELF."
+  (setf (scalar-coeff self) (multiply-by (scalar-coeff self) (scalar-coeff other))))
+
+(defmethod left-tensor-product-by ((self term) (other term))
+  (setf (scalar-coeff self) (multiply-by (scalar-coeff self) (scalar-coeff other)))
+  (call-next-method))
+
+(defmethod right-tensor-product-by ((self term) (other term))
+  (setf (scalar-coeff self) (multiply-by (scalar-coeff self) (scalar-coeff other)))
+  (call-next-method))
+
+(defmethod left-tensor-product-by ((self term) (other monom))
+  (call-next-method))
+
+(defmethod right-tensor-product-by ((self term) (other monom))
+  (call-next-method))
+
+(defmethod divide-by ((self term) (other term))
+  "Destructively divide term SELF by OTHER and store the result into SELF.
+It returns SELF."
+  (setf (scalar-coeff self) (divide-by (scalar-coeff self) (scalar-coeff other)))
+  (call-next-method))
+
+(defmethod unary-minus ((self term))
+  (setf (scalar-coeff self) (unary-minus (scalar-coeff self)))
+  self)
+
+(defmethod r* ((term1 term) (term2 term))
+  "Non-destructively multiply TERM1 by TERM2."
+  (multiply-by (copy-instance term1) (copy-instance term2)))
+
+(defmethod r* ((term1 number) (term2 monom))
+  "Non-destructively multiply TERM1 by TERM2."
+  (r* term1 (change-class (copy-instance term2) 'term)))
+
+(defmethod r* ((term1 number) (term2 term))
+  "Non-destructively multiply TERM1 by TERM2."
+  (setf (scalar-coeff term2) 
+	(r* term1 (scalar-coeff term2)))
+  term2)
+
+(defmethod r-zerop ((self term))
+  (r-zerop (scalar-coeff self)))
Index: branches/f4grobner/.junk/ring.lisp
===================================================================
--- branches/f4grobner/.junk/ring.lisp	(revision 3731)
+++ branches/f4grobner/.junk/ring.lisp	(revision 3731)
@@ -0,0 +1,232 @@
+;;; -*-  mode: lisp; package: maxima; syntax: common-lisp; base: 10 -*- 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;                                                                              
+;;;  copyright (c) 1999, 2002, 2009, 2015 marek rychlik <rychlik@u.arizona.edu>		 
+;;;  		       								 
+;;;  this program is free software; you can redistribute it and/or modify	 
+;;;  it under the terms of the gnu general public license as published by	 
+;;;  the free software foundation; either version 2 of the license, or		 
+;;;  (at your option) any later version.					 
+;;; 		       								 
+;;;  this program is distributed in the hope that it will be useful,		 
+;;;  but without any warranty; without even the implied warranty of		 
+;;;  merchantability or fitness for a particular purpose.  see the		 
+;;;  gnu general public license for more details.				 
+;;; 		       								 
+;;;  you should have received a copy of the gnu general public license		 
+;;;  along with this program; if not, write to the free software 		 
+;;;  foundation, inc., 59 temple place - suite 330, boston, ma 02111-1307, usa.	 
+;;;										 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defpackage "RING"
+  (:use :cl)
+  (:export "R-PARSE"
+	   "UNIT-ELEMENT"
+	   "R-ZEROP"
+	   "R+"
+	   "R-"
+	   "R*"
+	   "R+"
+	   "R/"
+	   "R-EXPT"
+	   "R-LCM"
+	   "R-EZGCD"
+	   "R-GCD"
+	   "R-TOTAL-DEGREE"
+	   "R-DIMENSION"
+	   "R-EXPONENTS"
+	   "R-COEFF"
+	   "R-SUGAR"
+	   "R-DIVIDES-P"   
+	   "R-DIVIDES-LCM-P"
+	   "R-LCM-DIVIDES-LCM-P"
+	   "R-LCM-EQUAL-LCM-P"
+	   "R-REL-PRIME-P"    
+	   "R-EQUALP"
+	   "R-CLONE"
+	   "R-ELT"
+	   "R->LIST"
+	   "R-DIVISIBLE-BY-P"	
+	   "R-REL-PRIME-P"	
+	   "R-DEPENDS-P"	
+	   "LEFT-TENSOR-PRODUCT-BY"
+	   "RIGHT-TENSOR-PRODUCT-BY"
+	   "LEFT-CONTRACT"
+	   "R-LENGTH"
+	   "MULTIPLY-BY"
+	   "DIVIDE-BY"
+	   "ADD-TO"
+	   "SUBTRACT-FROM"
+	   "UNARY-MINUS"
+	   "SCALAR"
+	   "SCALAR-COEFF"
+	   "INSERT-ITEM"
+	   "APPEND-ITEM")
+  (:shadowing-import-from 
+   #+openmcl-native-threads #:ccl 
+   #+cmu #:pcl
+   #+sbcl #:sb-pcl 
+   #+lispworks #:hcl 
+   #+allegro #:mop 
+   #+clisp #:clos
+   #:class-slots #:slot-definition-name)
+  (:documentation
+   "Implements ring operations.  These are all operations that are
+performed on the coefficients by the package, and thus the coefficient
+ring can be changed by merely redefining these operations."))
+
+(in-package :ring)
+
+(defclass scalar () 
+  ((coeff :initarg :coeff :accessor scalar-coeff))
+  (:default-initargs :coeff nil)
+  (:documentation "Wraps objects suitable as scalars/polynomial coefficients"))
+
+(defmethod print-object ((self scalar) stream)
+  (print-unreadable-object (self stream :type t :identity t)
+    (format stream "COEFF=~A"
+	    (slot-value self 'coeff))))
+
+(defgeneric unit-element (class))
+
+(defgeneric r-zerop (object)
+  (:method ((self number)) (zerop self))
+  (:documentation "Tests whether a ring element is 0."))
+
+(defgeneric r+ (x y)
+  (:method ((x number) (y number)) (+ x y))
+  (:documentation "Adds ring elements.")) 
+
+(defgeneric r- (minuend &rest subtrahends)
+  (:method ((minuend number) &rest subtrahends) (apply #'- (cons minuend subtrahends)))
+  (:documentation "Subtracts ring elements.")) 
+
+(defgeneric r* (x y)
+  (:method (x y) (* x y))
+  (:documentation "Multiplies ring elements.")) 
+
+(defgeneric left-tensor-product-by (self other)
+  (:documentation "Takes a tensor product of SELF with OTHER, where
+OTHER is the left factor."))
+
+(defgeneric right-tensor-product-by (self other)
+  (:documentation "Takes a tensor product of SELF with OTHER, where
+OTHER is the right factor."))
+
+(defgeneric r/ (numerator &rest denominators)
+  (:method ((numerator number) &rest denominators) (apply #'/ (cons numerator denominators)))
+  (:documentation "Divides ring elements.")) 
+
+(defgeneric r-lcm (x y)
+  (:method ((x integer) (y integer)) (lcm x y))
+  (:documentation "Returns the least common multiple of ring elements.")) 
+
+(defgeneric r-expt (x y)
+  (:method ((x number) (y integer)) (expt x y))
+  (:method ((x t) (y integer)) 
+    (declare (type fixnum y))
+    (cond
+      ((minusp y) (error "r-expt: Negative exponent."))
+      ((r-zerop x) (if (zerop y) 1))
+      (t
+       (do ((k 1 (ash k 1))
+	    (q x (r* q q))		;keep squaring
+	    (p 1 (if (not (zerop (logand k y))) (r* p q) p)))
+	   ((> k y) p)
+	 (declare (fixnum k))))))
+  (:documentation "Raises X to power Y.")) 
+
+(defgeneric r-ezgcd (x y)
+  (:method ((x integer) (y integer)
+	    &aux (c (gcd x y)))
+    (values c (/ x c) (/ y c)))
+  (:documentation "Solves the diophantine system: X=C*X1, Y=C*X2,
+C=GCD(X,Y).  It returns C, X1 and Y1. The result may be obtained by
+the Euclidean algorithm."))
+
+(defgeneric r-gcd (x y)
+  (:method ((x integer) (y integer))
+    (gcd x y))
+  (:documentation "Returns GCD(X,Y)."))
+
+(defgeneric r-dimension (object))
+(defgeneric r-exponents (object))
+
+(defgeneric r-coeff (object))
+(defgeneric (setf r-coeff) (new-value object))
+
+(defgeneric r-total-degree (object &optional start end))
+
+(defgeneric r-divides-p (object1 object2)
+  (:method ((object1 integer) (object2 integer))
+    (zerop (rem object2 object1)))
+  (:documentation "Returns T if OBJECT1 divides OBJECT2"))
+
+(defgeneric r-divides-lcm-p (object1 object2 object3)
+  (:documentation "Returns T if OBJECT divides LCM(OBJECT2, OBJECT3), NIL otherwise."))
+
+(defgeneric r-lcm-divides-lcm-p (object1 object2 object3 object4)
+  (:documentation "Returns T if LCM(OBJECT1,OBJECT2) divides LCM(OBJECT3,OBJECT4), NIL otherwise."))
+
+(defgeneric r-lcm-equal-lcm-p (object1 object2 object3 object4)
+  (:documentation "Returns T if object LCM(OBJECT1,OBJECT2) equals LCM(OBJECT3,OBJECT4), NIL otherwise."))
+
+(defgeneric r-equalp (object1 object2)
+  (:method (object1 object2) (equalp object1 object2))
+  (:method ((object1 list) (object2 list))
+    (every #'r-equalp object1 object2))
+  (:method ((object1 scalar) (object2 scalar))
+    (r-equalp (scalar-coeff object1) (scalar-coeff object2)))
+  (:documentation "Equality using deep comparison of object slots."))
+
+(defgeneric r-elt (object index)
+  (:documentation "Access a part of an object OBJECT with index INDEX."))
+
+(defgeneric (setf r-elt) (new-value object index)
+  (:documentation "A setter of a part of an object OBJECT with index INDEX."))
+
+(defgeneric r-length (object))
+
+(defgeneric r->list (object))
+(defgeneric r-sugar (object))
+(defgeneric r-rel-prime-p (object1 object2))
+(defgeneric left-contract (object k))
+(defgeneric r-divisible-by-p (object1 object2))
+(defgeneric r-depends-p (object k))
+
+(defgeneric multiply-by (self other)
+  (:method (self other) (r* self other))
+  (:documentation "Multiply object SELF and OTHER and store the result
+into SELF.  It returns SELF. For instances of a class, this operation
+may be destructive."))
+
+(defgeneric divide-by (self other)
+  (:method (self other) (r/ self other))
+  (:documentation "Divided object SELF by OTHER and store the result
+into SELF.  It returns SELF. For instances of a class, this operation
+may be destructive."))
+
+(defgeneric add-to (self other)
+  (:documentation "Add to object SELF another object OTHER.  For
+complex objects, it may destructively modify SELF and destructively
+modify/invalidate object OTHER. For standard classes implementing this
+method, the result should be an object which is EQ to SELF. For
+built-in classes, such as NUMBER, the returned object may not be EQ to
+the original, but it will be EQL to it.")
+  (:method (self other) (r+ self other)))
+
+(defgeneric subtract-from (self other)
+  (:documentation "Subtract from an object SELF another object OTHER.
+For complex objects, it may destructively modify SELF and
+destructively modify/invalidate object OTHER. For standard classes
+implementing this method, the result should be an object which is EQ
+to SELF. For built-in classes, such as NUMBER, the returned object may
+not be EQ to the original.")
+  (:method (self other) (r- self other)))
+
+(defgeneric unary-minus (self)
+  (:method ((x number)) (- x)))
+
+(defgeneric insert-item (self item))
+(defgeneric append-item (self item))
