source: branches/f4grobner/parser.lisp@ 628

;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                              
;;;  Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>          
;;;                                                                              
;;;  This program is free software; you can redistribute it and/or modify        
;;;  it under the terms of the GNU General Public License as published by        
;;;  the Free Software Foundation; either version 2 of the License, or           
;;;  (at your option) any later version.                                         
;;;                                                                              
;;;  This program is distributed in the hope that it will be useful,             
;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of              
;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               
;;;  GNU General Public License for more details.                                
;;;                                                                              
;;;  You should have received a copy of the GNU General Public License           
;;;  along with this program; if not, write to the Free Software                 
;;;  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
;;;                                                                              
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Maxima expression parsing
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(eval-when
    #+gcl (load eval)
    #-gcl (:load-toplevel :execute)
    (unless (find-package :maxima)
      (pushnew :fake-maxima *features*)
      (make-package "MAXIMA")
      ))

(defpackage "PARSER"
  (:use :cl)
  (:export "PARSE-POLY"
           "PARSE-POLY-LIST"
           "PARSE-POLY-LIST-LIST"))

(in-package :parser)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Functions and macros dealing with internal representation
;; structure.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun equal-test-p (expr1 expr2)
  #-fake-maxima(alike1 expr1 expr2)
  #+fake-maxima(equalp expr1 expr2)
  )

(defun coerce-maxima-list (expr)
  "Convert a Maxima list to Lisp list."
  (cond
   ((and (consp (car expr)) (eql (caar expr) 'maxima:mlist)) (cdr expr))
   (t expr)))

#+fake-maxima
(defun $freeof (vars expr)
  t)

(defun free-of-vars (expr vars) (apply #'$freeof `(,@vars ,expr)))

(defun parse-poly (expr vars &aux (vars (coerce-maxima-list vars)))
  "Convert a maxima polynomial expression EXPR in variables VARS to internal form."
  (labels ((parse (arg) (parse-poly arg vars))
           (parse-list (args) (mapcar #'parse args)))
    (cond
     ((eql expr 0) (make-poly-zero))
     ((member expr vars :test #'equal-test-p)
      (let ((pos (position expr vars :test #'equal-test-p)))
        (make-variable *expression-ring* (length vars) pos)))
     ((free-of-vars expr vars)
      ;;This means that variable-free CRE and Poisson forms will be converted
      ;;to coefficients intact
      (coerce-coeff *expression-ring* expr vars))
     (t
      (case (caar expr)
        (mplus (reduce #'(lambda (x y) (poly-add *expression-ring* x y)) (parse-list (cdr expr))))
        (mminus (poly-uminus *expression-ring* (parse (cadr expr))))
        (mtimes
         (if (endp (cddr expr))         ;unary
             (parse (cdr expr))
           (reduce #'(lambda (p q) (poly-mul *expression-ring* p q)) (parse-list (cdr expr)))))
        (mexpt
         (cond
          ((member (cadr expr) vars :test #'equal-test-p)
           ;;Special handling of (expt var pow)
           (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
             (make-variable *expression-ring* (length vars) pos (caddr expr))))
          ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
           ;; Negative power means division in coefficient ring
           ;; Non-integer power means non-polynomial coefficient
           (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
                  expr)
           (coerce-coeff *expression-ring* expr vars))
          (t (poly-expt *expression-ring* (parse (cadr expr)) (caddr expr)))))
        (mrat (parse ($ratdisrep expr)))
        (mpois (parse ($outofpois expr)))
        (otherwise
         (coerce-coeff *expression-ring* expr vars)))))))

(defun parse-poly-list (expr vars)
  "Parse a Maxima representation of a list of polynomials."
  (case (caar expr)
    (mlist (mapcar #'(lambda (p) (parse-poly p vars)) (cdr expr)))
    (t (merror "Expression ~M is not a list of polynomials in variables ~M."
               expr vars))))

(defun parse-poly-list-list (poly-list-list vars)
  "Parse a Maxima representation of a list of lists of polynomials."
  (mapcar #'(lambda (g) (parse-poly-list g vars)) (coerce-maxima-list poly-list-list)))