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

(defun equal-test-p (expr1 expr2)
  (alike1 expr1 expr2))

(defun coerce-maxima-list (expr)
  "convert a maxima list to lisp list."
  (cond
   ((and (consp (car expr)) (eql (caar expr) 'mlist)) (cdr expr))
   (t expr)))

(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 *maxima-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 *maxima-ring* expr vars))
     (t
      (case (caar expr)
	(mplus (reduce #'(lambda (x y) (poly-add *maxima-ring* x y)) (parse-list (cdr expr))))
	(mminus (poly-uminus *maxima-ring* (parse (cadr expr))))
	(mtimes
	 (if (endp (cddr expr))		;unary
	     (parse (cdr expr))
	   (reduce #'(lambda (p q) (poly-mul *maxima-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 *maxima-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 *maxima-ring* expr vars))
	  (t (poly-expt *maxima-ring* (parse (cadr expr)) (caddr expr)))))
	(mrat (parse ($ratdisrep expr)))
	(mpois (parse ($outofpois expr)))
	(otherwise
	 (coerce-coeff *maxima-ring* expr vars)))))))

(defun parse-poly-list (expr vars)
  (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)
  (mapcar #'(lambda (g) (parse-poly-list g vars)) (coerce-maxima-list poly-list-list)))