#|
	$Id: printer.lisp,v 1.3 2009/01/22 04:06:32 marek Exp $	
  *--------------------------------------------------------------------------*
  |  Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@math.arizona.edu)    |
  |    Department of Mathematics, University of Arizona, Tucson, AZ 85721    |
  |                                                                          |
  | Everyone is permitted to copy, distribute and modify the code in this    |
  | directory, as long as this copyright note is preserved verbatim.         |
  *--------------------------------------------------------------------------*
|#
(defpackage "PRINTER"
  (:export poly-print print-term print-monom)
  (:use "COMMON-LISP"))
  
(in-package "PRINTER")

#+debug(proclaim '(optimize (speed 0) (debug 3)))
#-debug(proclaim '(optimize (speed 3) (safety 0)))

(defun poly-print (plist vars &optional (stream t))
  "Prints a polynomial or  a list of polynomials PLIST using infix syntax compatible
with most software systems. The following data representations are assumed:
1) Polynomial list is ([ poly1 poly2 ...)
2) Polynomial is a list (term1 term2 ...)
3) Term is (monom . number)
4) Monom is (number1 number2 ...) and is a list of powers at corresponding 
variables
Variable names must be provided to the printer explicitly."
  (cond 
    ((and (symbolp (car plist)) (string= (symbol-name (car plist)) "["))
     (format stream "[ ")
     (poly-print-2 (rest plist) vars stream)
     (format stream " ]"))
    ;; Not a list but a single polynomial
    (t (poly-print-1 plist vars stream))))

(defun poly-print-1 (p vars &optional (stream t))
  "An auxillary function of POLY-PRINT. It prints a single polynomial P."
  (labels ((infix-sum (l &optional (beg t))
	     (unless (endp l)
	       (infix-term (first l) beg)
	       (infix-sum (rest l) nil)))
 	   (infix-term (l &optional beg)
	     (unless (zerop (cdr l))
	       (case (cdr l)
		 (1 (unless beg (format stream " + "))
		    (infix-monom (first l) vars t))
		 (-1 (format stream " - ") (infix-monom (first l) vars t))
		 (otherwise
		  (cond
		    ((plusp (cdr l)) (unless beg (format stream " + ")))
		    ((minusp (cdr l)) (format stream " - ")))
		  (format stream "~d" (abs (cdr l)))
		  (infix-monom (first l) vars nil)))))
 	   (infix-monom (l vars &optional beg)
	     (cond
	       ((endp l) (when beg (format stream "~d" 1)))
	       (t
		(unless (zerop (car l))
		  (unless beg (format stream " * "))
		  ;; if in x^n we have n=1 then print just x
		  (format stream "~a~:[^~d~;~*~]" (car vars)
			  (= (car l) 1) (car l)))
		(infix-monom (rest l) (rest vars) (and (zerop (car l)) beg)))
	       )))
    (if (endp p)
	(format stream "0")
      (infix-sum p)))
  p)

(defun poly-print-2 (plist vars stream &optional (beg t))
  "An auxillary function of POLY-PRINT. It prints a comma-separated list of polynomials PLIST."
  (unless (endp plist)
    (unless beg (format stream ", "))
    (poly-print-1 (first plist) vars stream)
    (poly-print-2 (rest plist) vars stream nil)))


(defun print-term (l vars &optional (stream t) beg)
  "An auxillary function of POLY-PRINT. It prints a single term L."
  (unless (zerop (cdr l))
    (case (cdr l)
      (1 (unless beg (format stream " + "))
	 (print-monom (first l) vars stream t))
      (-1 (format stream " - ") (print-monom (first l) vars stream t))
      (otherwise
       (cond
	((plusp (cdr l)) (unless beg (format stream " + ")))
	((minusp (cdr l)) (format stream " - ")))
       (format stream "~d" (abs (cdr l)))
       (print-monom (first l) vars stream nil)))))

(defun print-monom (l vars &optional (stream t) beg)
  "An auxillary function of POLY-PRINT. It prints a single monomial L."
  (cond
   ((endp l) (when beg (format stream "~d" 1)))
   (t
    (unless (zerop (car l))
      (unless beg (format stream " * "))
      ;; if in x^n we have n=1 then print just x
      (format stream "~a~:[^~d~;~*~]" (car vars)
	      (= (car l) 1) (car l)))
    (print-monom (rest l) (rest vars) stream (and (zerop (car l)) beg)))
   ))