Index: trunk/src/infix-printer.lisp
===================================================================
--- trunk/src/infix-printer.lisp	(revision 39)
+++ trunk/src/infix-printer.lisp	(revision 41)
@@ -18,4 +18,6 @@
 (in-package "INFIX-PRINTER")
 
+(proclaim '(optimize (speed 0) (debug 3)))
+
 (defun infix-print-separated-list (lst sep stream op print-level
 				   &optional (alt-op nil) (alt-sep alt-op)
@@ -26,20 +28,48 @@
   (cond
    ((endp lst) nil)
-   ((and (numberp *print-level*) (> print-level *print-level*))
+
+   ;; Handle *print-level* 
+   ((and (numberp *print-level*)
+	 (> print-level *print-level*))
     (format stream "#"))
+
    (t
-    (dolist (arg lst (infix-print arg stream op print-level))
+    (dolist (arg lst)
       (setf true-sep sep)
       (incf count)
-      (when (and alt-op (> count 1) (consp arg) (eq alt-op (car arg)))
-	  (setf arg (cadr arg)
-		true-sep alt-sep))
+
+      (when (and alt-op
+		 (> count 1)
+		 (consp arg)
+		 (eq alt-op (car arg)))
+	(setf arg (cadr arg)
+	      true-sep alt-sep))
       (if beg
 	  (setf beg nil)
-	(format stream "~a" true-sep))
+	  (format stream "~a" true-sep))
+      
+      ;; If *print-length* exceeded, print ellipsis
       (when (and (numberp *print-length*) (> count *print-length*))
 	(format stream "...")
-	(return-from infix-print-separated-list))))))
+	(return-from infix-print-separated-list (values)))
+      
+      (infix-print arg stream op print-level))))
+  (values))
 
+
+(defun infix-print-arg-list (lst stream print-level
+			     &aux (count 0))
+  "Print a comma-separated list"
+
+  ;; Arguments never need to be parenthesized?
+  (dolist (e (butlast lst))
+    (infix-print e stream (1+ print-level))
+    (when (and (numberp *print-length*)
+	       (> count *print-length*))
+      (format stream "...")
+      (return-from infix-print-arg-list (values)))
+    (format stream ","))
+  (infix-print (car (last lst)) stream (1+ print-level)))
+    
 
 (defun infix-print (expr &optional (stream t) (op nil) (print-level 0))
@@ -48,50 +78,81 @@
 has lower precedence than OP."
   (cond 
-   ((and (numberp *print-level*) (> print-level *print-level*))
+    ;; Handle *print-level*
+   ((and (numberp *print-level*)
+	 (> print-level *print-level*))
     (format stream "#"))
-   ((null expr) (error "Null expression."))
-   ((atom expr) (format stream "~a" expr))
+
+   ;; Null expression is an error
+   ((null expr)
+    (error "Null expression."))
+
+   ;; Atoms are printed using ~A format directive
+   ((atom expr)
+    (format stream "~a" expr))
+   
+   ;; Check if the operator of this expression has lower precedence
+   ;; than the surrounding operator, and parenthesize if necessary
    ((and op (operator-lessp (car expr) op))
     (format stream "(")
     (infix-print expr stream nil (1+ print-level))
     (format stream ")"))
-   ((and (eq (car expr) '-)
-	 (endp (cddr expr)))		;unary minus
+
+   ;; Unary minus needs special handling
+   ((and (eq (car expr) '-) (endp (cddr expr)))
     (format stream "-")
+    ;; Print the second element in product context
     (infix-print (cadr expr) stream '* (1+ print-level)))
+
+   ;; All other operators
    (t 
     (case (car expr)
+
+      ;; Arithmetic operators
       ((+ - * /)
-       (infix-print-separated-list (cdr expr) (car expr) stream (car expr) (1+ print-level)
-				   (cond ((eq (car expr) '+) '-)
-					 ((eq (car expr) '-) '-)
-					 (t nil))))
-      (wedge
-       (infix-print-separated-list (cdr expr) '|/\\| stream '* (1+ print-level)))
+       (infix-print-separated-list
+	(cdr expr)
+	(car expr)
+	stream
+	(car expr)
+	(1+ print-level)
+	(cond ((eq (car expr) '+) '-)
+	      ((eq (car expr) '-) '-)
+	      (t nil))))
+
+      ;; Exponentials
       (expt
        (unless (= (length (cdr expr)) 2)
 	 (error "expt must take 2 arguments."))
-       (infix-print-separated-list (cdr expr) '^ stream '^ (1+ print-level)))
-      (otherwise			;assumed function call
+       (infix-print-separated-list
+	(cdr expr)
+	'^
+	stream
+	'^
+	(1+ print-level)))
+
+      ;; Assuming function call
+      (otherwise		
        (cond
-	((and (eq (car expr) 'd)
-	      (consp (cdr expr))
-	      (symbolp (cadr expr)))
-	 ;; Special syntax for differential forms
-	 (format stream "d~a" (cadr expr)))
-	((eq (car expr) 'aref)
-	 ;; Special syntax for subscripted variables
-	 ;; consistent with the infix package.
-	 (format stream "~a[" (cadr expr))
-	 (infix-print-separated-list (cddr expr) '\, stream '\, (1+ print-level))
-	 (format stream "]"))
-	((and (symbolp (car expr))
-	      (string= (symbol-name (car expr)) "["))
-	 (format stream "[")
-	 (infix-print-separated-list (cdr expr) '\, stream '\, (1+ print-level))
-	 (format stream "]"))
-	(t
-	 ;; Generic function call syntax
-	 (format stream "~a(" (car expr))
-	 (infix-print-separated-list (cdr expr) '\, stream '\, (1+ print-level))
-	 (format stream ")"))))))))
+	 ;; Handle array references
+	 ((eq (car expr) 'aref)
+	  ;; Special syntax for subscripted variables
+	  ;; consistent with the infix package.
+	  (format stream "~a[" (cadr expr))
+	  (infix-print-separated-list (cddr expr) '\, stream '\, (1+ print-level))
+	  (format stream "]"))
+
+	 ;; Handle lists
+	 ((and (symbolp (car expr))
+	       (string= (symbol-name (car expr)) "["))
+	  (format stream "[")
+	  (infix-print-separated-list (cdr expr) '\, stream '\, (1+ print-level))
+	  (format stream "]"))
+
+
+	 ;; Handle generic function call syntax
+	 (t
+
+	  (format stream "~a(" (car expr))
+	  (infix-print-arg-list (cdr expr) stream (1+ print-level))
+	  (format stream ")")))))))
+  (values))
