Changeset 222 for branches

Timestamp:

2015-06-05T15:36:03-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/mx-grobner.lisp (modified) (1 diff)

branches/f4grobner/mx-grobner.lisp

@@ -255 +255 @@
   "Returns the polynomial P divided by the leading coefficient.")
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Macro facility for writing Maxima-level wrappers for
+;; functions operating on internal representation
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro with-parsed-polynomials (((maxima-vars &optional (maxima-new-vars nil new-vars-supplied-p))
+                                    &key (polynomials nil)
+                                         (poly-lists nil)
+                                         (poly-list-lists nil)
+                                         (value-type nil))
+                                   &body body
+                                   &aux (vars (gensym))
+                                        (new-vars (gensym)))
+  `(let ((,vars (coerce-maxima-list ,maxima-vars))
+         ,@(when new-vars-supplied-p
+             (list `(,new-vars (coerce-maxima-list ,maxima-new-vars)))))
+     (coerce-to-maxima
+      ,value-type
+      (with-coefficient-ring ($poly_coefficient_ring)
+        (with-monomial-order ($poly_monomial_order)
+          (with-elimination-orders ($poly_primary_elimination_order
+                                    $poly_secondary_elimination_order
+                                    $poly_elimination_order)
+            (let ,(let ((args nil))
+                    (dolist (p polynomials args)
+                      (setf args (cons `(,p (parse-poly ,p ,vars)) args)))
+                    (dolist (p poly-lists args)
+                      (setf args (cons `(,p (parse-poly-list ,p ,vars)) args)))
+                    (dolist (p poly-list-lists args)
+                      (setf args (cons `(,p (parse-poly-list-list ,p ,vars)) args))))
+              . ,body))))
+      ,(if new-vars-supplied-p
+           `(append ,vars ,new-vars)
+         vars))))
+
+
 ;;Functions