Changeset 221

Timestamp:

2015-06-05T15:35:37-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

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

branches/f4grobner/ngrobner.lisp

@@ -282 +282 @@
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; 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))))
-
-
+
+