Changeset 2432 for branches

Timestamp:

2015-06-19T08:07:07-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

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

branches/f4grobner/order.lisp

@@ -41 +41 @@
 (proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))
 
-(defgeneric order (p q &optional start end))
-
 ;; pure lexicographic
-(defmethod lex> ((p monom) (q monom) &optional (start 0) (end (monom-dimension  p)))
-  "Return T if P>Q with respect to lexicographic order, otherwise NIL.
+(defgeneric lex> (p q &optional start end)
+  (:method ((p monom) (q monom) &optional (start 0) (end (monom-dimension  p)))
+    "Return T if P>Q with respect to lexicographic order, otherwise NIL.
 The second returned value is T if P=Q, otherwise it is NIL."
-  (declare (type fixnum start end))
-  (do ((i start (1+ i)))
-      ((>= i end) (values nil t))
-    (cond
-     ((> (r-elt p i) (r-elt q i))
-      (return-from lex> (values t nil)))
-     ((< (r-elt p i) (r-elt q i))
-      (return-from lex> (values nil nil))))))
+    (declare (type fixnum start end))
+    (do ((i start (1+ i)))
+        ((>= i end) (values nil t))
+      (cond
+        ((> (r-elt p i) (r-elt q i))
+         (return-from lex> (values t nil)))
+        ((< (r-elt p i) (r-elt q i))
+         (return-from lex> (values nil nil)))))))
 
 ;; total degree order , ties broken by lexicographic
-(defmethod grlex> ((p monom) (q monom) &optional (start 0) (end (monom-dimension  p)))
-  "Return T if P>Q with respect to graded lexicographic order, otherwise NIL.
+(defgeneric grlex> (p q &optional start end)
+  (:method ((p monom) (q monom) &optional (start 0) (end (monom-dimension  p)))
+    "Return T if P>Q with respect to graded lexicographic order, otherwise NIL.
 The second returned value is T if P=Q, otherwise it is NIL."
-  (declare (type monom p q) (type fixnum start end))
-  (let ((d1 (r-total-degree p start end))
-        (d2 (r-total-degree q start end)))
-    (declare (type fixnum d1 d2))
-    (cond
-      ((> d1 d2) (values t nil))
-      ((< d1 d2) (values nil nil))
-      (t
-        (lex> p q start end)))))
+    (declare (type monom p q) (type fixnum start end))
+    (let ((d1 (r-total-degree p start end))
+          (d2 (r-total-degree q start end)))
+      (declare (type fixnum d1 d2))
+      (cond
+        ((> d1 d2) (values t nil))
+        ((< d1 d2) (values nil nil))
+        (t
+         (lex> p q start end))))))