Index: branches/f4grobner/pair-queue.lisp
===================================================================
--- branches/f4grobner/pair-queue.lisp	(revision 4002)
+++ branches/f4grobner/pair-queue.lisp	(revision 4135)
@@ -27,6 +27,7 @@
 	   "CRITICAL-PAIR-QUEUE"
 	   "SELECTION-STRATEGY"
-	   "MIN-TOTAL-DEGREE-STRATEGY"
-	   "MIN-COMBINED-LENGTH-STRATEGY"
+	   "+NORMAL-STRATEGY+"
+	   "+MIN-TOTAL-DEGREE-STRATEGY+"
+	   "+MIN-COMBINED-LENGTH-STRATEGY+"
 	   "MAKE-CRITICAL-PAIR-QUEUE"
 	   )
@@ -58,6 +59,5 @@
 		  :initarg :pair-order-fn 
 		  :accessor pair-order-fn))
-  (:documentation "Represents the normal critical pair selection
-strategy.  The two ingredients of a strategy is a function
+  (:documentation "The two ingredients of a strategy is a function
 PAIR-KEY-FUNCTION which computes a key from the critical pair, which
 can be any type of data, and a function PAIR-ORDER-FN used to compaire
@@ -75,34 +75,57 @@
 	      pair-key-fn pair-order-fn))))
 
-(defclass min-total-degree-strategy (selection-strategy)
-  ((pair-key-fn :initform #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q)))))
-   (pair-order-fn :initform #'<))
-  (:documentation "Make a selection strategy where a pair with a
-minimum total degree of LCM of leading monomials is selected."))
+(defparameter +normal-strategy+
+  (make-instance 
+   'selection-strategy
+   :pair-key-fn #'(lambda (p q) (universal-lcm (leading-monomial p) (leading-monomial q)))
+   :pair-order-fn #'lex>)
+  "The normal selection strategy where a pair with the largest LCM of
+leading monomials is selected.")
 
-(defclass min-combined-length-strategy (selection-strategy)
-  ((pair-key-fn :initform #'(lambda (p q) (+ (poly-length p) (poly-length q))))
-   (pair-order-fn :initform #'<))
-  (:documentation "Make a selection strategy where a pair with the minimum combined length of both
-polynomials is selected."))
+(defparameter +min-total-degree-strategy+
+  (make-instance 
+   'selection-strategy
+   :pair-key-fn #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q))))
+   :pair-order-fn #'<)
+  "A selection strategy where a pair with a minimum total degree of
+  LCM of leading monomials is selected.")
 
-(defun make-critical-pair-queue (&key pair-key-fn pair-order-fn (poly-list nil) (start 1)
-				 &aux (pq (make-instance 'priority-queue
-							 :element-type 'critical-pair
-							 :element-key #'(lambda (pair) (funcall pair-key-fn 
-												(critical-pair-first pair)
-												(critical-pair-second pair)))
-							 :test pair-order-fn)))
-  "Makes a priority queue for critical pairs. The argument POLY-LIST should the initial list of polynomials.
-and START is the first position beyond the elements which form a
-partial Grobner basis, i.e. satisfy the Buchberger criterion."
-    ;; Add critical pairs for polynomials in POLY-LIST
-  (let* ((s (1- (length poly-list)))
-	 (b (nconc (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
-			     (i 0 (1- start)) (j start s))
-		   (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
-			     (i start (1- s)) (j (1+ i) s)))))
-    (dolist (pair b pq)
-      (enqueue pq pair))))
+(defparameter +min-combined-length-strategy+
+  (make-instance
+   'selection-strategy
+   :pair-key-fn #'(lambda (p q) (+ (poly-length p) (poly-length q)))
+   :pair-order-fn #'<)
+  "A selection strategy where a pair with the minimum combined length of both
+polynomials is selected.")
+
+(defclass critical-pair-queue (priority-queue) 
+  ()
+  (:documentation "Implements critical pair priority queue."))
+
+(defmethod allocate-instance ((self critical-pair-queue) &key strategy poly-list start)
+  "Allocates a priority queue SELF for critical pairs from strategy SELF."
+  (declare (ignore poly-list start))
+  (with-slots (pair-key-fn pair-order-fn)
+      strategy
+    (reinitialize-instance self
+			   :element-type 'critical-pair
+			   :element-key #'(lambda (pair) (funcall pair-key-fn 
+								  (critical-pair-first pair)
+								  (critical-pair-second pair)))
+			   :test pair-order-fn)))
+
+(defgeneric enqueue-critical-pairs (self &optional poly-list start)
+  (:method ((self critical-pair-queue) &optional (poly-list nil) (start 0))
+    "The argument POLY-LIST should the initial list of
+polynomials.  and START is the first position beyond the elements
+which form a partial Grobner basis, i.e. satisfy the Buchberger
+criterion."
+    (let* ((s (1- (length poly-list)))
+	   (b (nconc (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
+			       (i 0 (1- start)) (j start s))
+		     (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
+			       (i start (1- s)) (j (1+ i) s)))))
+      (dolist (pair b self)
+	(enqueue self pair)))))
 
 
