Operator Precedence Parser

(defun expr (inp)          ; opprecc.lsp
  (let (token *op-stack* *opnd-stack*)
    (while inp
      (setq token (pop inp))
      (if (consp token)         ; (exp)
          (push (expr token) *opnd-stack*)
          (if (operatorp token)
              (progn
                (while
                  (>= (prec (first *op-stack*))
                            (prec token))
                  (reducex))
                (push token *op-stack*))
              (push token *opnd-stack*))))
    (while *op-stack* (reducex))
    (pop *opnd-stack*) ))

; Reduce top of stacks to operand
(defun reducex ()
  (let ((rhs (pop *opnd-stack*)))
    (push (list (pop *op-stack*)    ; op
                (pop *opnd-stack*)  ; lhs
                rhs)                ; rhs
          *opnd-stack*) ))