(defun infix2rpn (exp)
  (lisp2rpn (infix2lisp exp)))

(defun lisp2rpn (exp)
  (cond ((not (listp exp))
         exp)
        ((= (length exp) 2)
         (format nil "~A,~A"
                 (lisp2rpn (second exp))
                 (first exp)))
        (t ; FIXME: Assumes length of 3
         (format nil "~A,~A,~A"
                 (lisp2rpn (second exp))
                 (lisp2rpn (third exp))
                 (first exp)))))

(defvar *operators* '(< > = + - * / ^)) ; in precedence order
(defvar *operators-as-chars*
  (mapcar (lambda (x) (coerce x 'character)) *operators*))

(defun infix2lisp (exp)
  (if (not (listp exp))
      exp
      (case (length exp)
        (1 (first exp))
        (2 (list (first exp) (infix2lisp (second exp)))) ;; (f (args))
        (3 (list (second exp)
                 (infix2lisp (first exp))
                 (infix2lisp (third exp))))
        (t (multiple-value-bind (i op) (position-of-min exp *operators*)
             (let ((left (butlast exp (- (length exp) i)))
                   (right (nthcdr (1+ i) exp)))
               (list op (infix2lisp left) (infix2lisp right))))))))

(defun position-of-min (list ordering)
  (let ((min-index (length ordering))
        (min-value nil)
        (position -1)
        (i 0))
    (dolist (x list (values position min-value))
      (let ((pos (position x ordering)))
        (when (and pos (<= pos min-index))
          (setf position i min-index pos min-value x)))
      (incf i))))

(defun read-line-as-list ()
  (read-delimited-list #\|
                       (make-string-input-stream (concatenate 'string
                                                              (tokenise (read-line))
                                                              " |"))))

(defun tokenise (string)
  (let ((last-char #\Space))
    (reduce (lambda (x y)
              (let ((sp (if (and (member y *operators-as-chars*)
                                 (not (member last-char *operators-as-chars*))) " " "")))
                (setf last-char y)
                (concatenate 'string (string x) sp (string y) sp)))
            string)))

(setf *print-case* :downcase)
(sb-sys:enable-interrupt sb-unix:sigint (lambda (sig code scp)
                                          (declare (ignore sig code scp))
                                          (quit)))
(handler-case
    (loop ;; press Control-C to quit
       (format t "~A~%" (infix2rpn (read-line-as-list)))
       (force-output))
  (t () (format t "Error, quitting~%") (quit)))

(c) 2006, Bill Moorier