Changeset 1811 for branches/f4grobner

Timestamp:

2015-06-15T12:57:10-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/mx-grobner.lisp (modified) (3 diffs)

branches/f4grobner/mx-grobner.lisp

@@ -368 +368 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
-;; Unary and binary operation definition facility
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro define-unop ((maxima-name fun-name (&rest args) &key (env :ring-and-order))
-                       &optional 
-                         (documentation nil documentation-supplied-p)
-                       &aux
-                         ;; The argument passed as first arg
-                         (env-arg (ecase env
-                                    (:ring-and-order 'ring-and-order)
-                                    (:ring 'ring))))
+;; N-ary (unary and binary) operation definition facility
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro define-op (maxima-name (fun-name &rest args) 
+                     &key (env :ring-and-order)
+                     &optional 
+                       (documentation nil documentation-supplied-p)
+                     &aux
+                       ;; The argument passed as first arg
+                       (env-arg (ecase env
+                                  (:ring-and-order 'ring-and-order)
+                                  (:ring 'ring))))
   "Define a MAXIMA-level unary operator MAXIMA-NAME corresponding to unary function FUN-NAME."
   `(defmfun ,maxima-name (,@args vars)
@@ -386 +387 @@
        (,fun-name ,env-arg ,@args p))))
 
-(defmacro define-binop ((maxima-name fun-name)
-                        &optional (documentation nil documentation-supplied-p))
-  "Define a MAXIMA-level binary operator MAXIMA-NAME corresponding to binary function FUN-NAME."
-  `(defmfun ,maxima-name (p q vars)
-     ,@(when documentation-supplied-p (list documentation))
-     (with-ring-and-order ((vars) :polynomials (p q) :value-type :polynomial)
-       (,fun-name ring-and-order p q))))
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -405 +397 @@
 
 ;;Simple operators
-(define-binop ($poly_add poly-add (p q))
+(define-op $poly_add (poly-add p q)
   "Adds two polynomials P and Q")
 
-(define-binop ($poly_subtract poly-sub (p q))
+#|
+(define-op ($poly_subtract poly-sub (p q))
   "Subtracts a polynomial Q from P.")
 
-(define-binop ($poly_multiply poly-mul (p q))
+(define-op ($poly_multiply poly-mul (p q))
   "Returns the product of polynomials P and Q.")
 
-(define-binop ($poly_s_polynomial spoly (p q))
+(define-op ($poly_s_polynomial spoly (p q))
   "Returns the syzygy polynomial (S-polynomial) of two polynomials P and Q.")
 
-(define-unop ($poly_primitive_part poly-primitive-part (p) :env :ring)
+(define-op ($poly_primitive_part poly-primitive-part (p) :env :ring)
   "Returns the polynomial P divided by GCD of its coefficients.")
 
-(define-unop ($poly_normalize poly-normalize (p) :env :ring)
+(define-op ($poly_normalize poly-normalize (p) :env :ring)
   "Returns the polynomial P divided by the leading coefficient.")
 
-
+|#
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;